Использование массива для поиска по столбцу и вставки новой строки

Question

У меня уже есть функция поиска, которая просматривает столбец A и пытается найти значение цифры c, если значение будет найдено, оно вставит строку выше и напечатает значения из пользовательской формы в ячейки внутри недавно вставленного строка. Тем не менее, таблица всегда растет, и если бояться, она станет очень медленной.

Ранее я пытался использовать массив, но моя попытка занимает больше времени и приводит к зависанию компьютера на длительный период времени.

Мой оригинальный код вставлен ниже. Мне бы идеально хотелось, чтобы этот процесс был намного быстрее и надежнее.

Private Sub CommandButtonSave_Click()

Application.ScreenUpdating = False
Application.Calculation = xlManual

'Declare variables
Dim subtaskws As Worksheet: Set subtaskws = ThisWorkbook.Sheets("Sub Tasks")
Dim ActivityWs As Worksheet: Set ActivityWs = ThisWorkbook.Sheets("Activity Overview")
Dim lastrow As Long, lastrowAO As Long, cellinput As Variant, newrow As Long, lastcollet As String, lastcol As Long, findtasknum As range, lastrowST As Long, cell As range, found As Variant, activitynum As Long

'Find column Letters
Call ColumnLetterFinder(subtaskws, 2, "Actual Workload", AWCol)
Call ColumnLetterFinder(subtaskws, 2, "W.", WCol)
Call ColumnLetterFinder(subtaskws, 2, "I.", ICol)
Call ColumnLetterFinder(subtaskws, 2, "E.", ECol)
Call ColumnLetterFinder(subtaskws, 2, "P", PCol)
Call ColumnLetterFinder(subtaskws, 2, "Level", LevelCol)

'find lastrows, columns and cells
lastrow = (subtaskws.range("A" & Rows.Count).End(xlUp).row) + 1
lastcol = subtaskws.Cells(2, 1).End(xlToRight).Column
lastcollet = lastcol
lastcollet = Split(Cells(1, lastcol).Address, "$")(1)
lastrowST = subtaskws.range("A" & Rows.Count).End(xlUp).row
activitynum = AddTask.TextBoxid.Value + 1

Dim Ctrl As Variant, range1 As range, userformorder As Variant, col As Long
userformorder = Array("SubTaskID", "TextBoxsubtask", "ComboBoxDeliverableFormat", "TextBoxcheckedcomplete", "TextBoxformat", "TextBoxacceptancecriteria", "BudgetWorkloadTextBox", "AWLTextBox", "ComboBoxOwner", "TextBoxTDSNumber", "TextBoxMilestone", "TextBoxTargetDeliveryDate", "ComboBoxW", "ComboBoxI", "ComboBoxe", "TextBoxP", "TextBoxLevel", "TextBoxInputQuality", "TextBoxNewInput", "TextBoxDelay", "TextBoxInternalVV", "TextBoxReviewer", "TextBoxDelivered", "ComboBoxNumIterations", "ComboBoxAcceptance", "ComboBoxProgress", "ComboBoxStatus", "ComboBoxFlowChart", "TextBoxActivitySheet", "TextBoxEvidenceofDelivery", "TextBoxComments") 'etc

'Find row before subtaskId number
Set found = subtaskws.range("A3:A" & lastrowST).Find(What:=(activitynum), LookAt:=xlWhole)
If found Is Nothing Then
    newrow = lastrow

subtaskws.range("A4:" & lastcollet & "4").EntireRow.Copy
subtaskws.range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
subtaskws.range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
subtaskws.range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
subtaskws.range("A" & newrow & ":AE" & newrow & "").ClearContents
subtaskws.Columns("A:BB").Calculate

For Each Ctrl In userformorder
If col = 8 Then
Else
    If AddTask.Controls(Ctrl).Value <> "" Then
        subtaskws.range("A" & newrow).Offset(, col).Value = AddTask.Controls(Ctrl).Value
    End If
col = col + 1
End If
Next Ctrl

subtaskws.Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
subtaskws.Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
subtaskws.Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"

Else
    subtaskws.range("A" & (found.row)).EntireRow.Insert
    newrow = found.row - 1
    subtaskws.range("A4:" & lastcollet & "4").EntireRow.Copy
    subtaskws.range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
    subtaskws.range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
    subtaskws.range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
    subtaskws.range("A" & newrow & ":AE" & newrow & "").ClearContents

For Each Ctrl In userformorder
    If AddTask.Controls(Ctrl).Value <> "" Then
        subtaskws.range("A" & newrow).Offset(, col).Value = AddTask.Controls(Ctrl).Value
    End If
col = col + 1
Next Ctrl

subtaskws.Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
subtaskws.Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
subtaskws.Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"

End If

    TextBoxsubtask.Value = Null
    ComboBoxDeliverableFormat.Value = Null
    TextBoxformat.Value = Null
    ComboBoxOwner.Value = Null
    TextBoxTargetDeliveryDate.Value = Null
    ComboBoxW.Value = Null
    ComboBoxI.Value = Null
    ComboBoxe.Value = Null
    TextBoxP.Value = Null
    TextBoxLevel.Value = Null
    TextBoxComments.Value = Null
    TextBoxEvidenceofDelivery.Value = Null
    TextBoxActivitySheet.Value = Null
    ComboBoxFlowChart.Value = Null
    ComboBoxStatus.Value = Null
    ComboBoxProgress.Value = Null
    ComboBoxAcceptance.Value = Null
    ComboBoxNumIterations.Value = Null
    TextBoxDelivered.Value = Null
    TextBoxReviewer.Value = Null
    TextBoxInternalVV.Value = Null
    TextBoxDelay.Value = Null
    TextBoxNewInput.Value = Null
    TextBoxInputQuality.Value = Null
    TextBoxMilestone.Value = Null
    TextBoxTDSNumber.Value = Null
    TextBoxacceptancecriteria.Value = Null
    TextBoxcheckedcomplete.Value = Null
    SubTaskID.Value = SubTaskID.Value + 0.01

Application.ScreenUpdating = True
Application.Calculation = xlAutomatic

End Sub
```