Maximizing VBA Processing Speed

[St Jimmy]

Hi all,
I'm trying to maximize the speed of my macro, I've included all the tricks I know but it still takes 5 min to process and I'd appreciate any advice on how to optimize the processing of my code. I've narrowed it down to two parts that lag and have included all relevant code below. The data is coming from a worksheet with 102,000 rows and 11 columns which is bad for processors health but unfortunately necessary...

It's not included in the code below, but I have turned off screen updating, disabled automatic calculation, disabled events and disabled status bar.

Sub SortTests() 
Dim i As Integer, j As Integer, k As Integer, NumTests As Integer, NumUnverified As Integer, NumRejected As Integer, NumAccepted As Integer
Dim TDLastRow As Long, RowNum As Long, LastRow As Long
Dim DataRange As Range, TransferredRange As Range


    DataRange.Sort key1:=Range(Cells(4, 10), Cells(LastRow, 10))
    For i = 1 To NumTests
        If Cells(i + 3, 10).Value = 4 Or Cells(i + 3, 10).Value = 5 Then  'If data line is marked as rejected or accepted
            RowNum = Functions.DoesTestExist(Cells(i + 3, 5), Cells(i + 3, 6), Cells(i + 3, 7), Cells(i + 3, 9), Cells(i + 3, 13))
            If RowNum > 0 Then
                Sheets(TD).Cells(RowNum, 6).Value = Sheets(TBU).Cells(i + 3, 8).Value 'Replaces old result with new value
                Sheets(TD).Cells(RowNum, 8).Value = Sheets(TBU).Cells(i + 3, 10).Value 'Replaces old status with new value
                Sheets(TD).Cells(RowNum, 10).Value = Sheets(TBU).Cells(i + 3, 12).Value 'Replaces old modified with new value
                Sheets(TBU).Range(Sheets(TBU).Cells(i + 3, 3), Sheets(TBU).Cells(i + 3, 13)).ClearContents  'Since the prior record was updated, clear the import
            Else
                LastRow = Sheets(TD).Cells(Rows.Count, 1).End(xlUp).row
                Sheets(TD).Range(Sheets(TD).Cells(LastRow + 1, 1), Sheets(TD).Cells(LastRow + 1, 11)).Value = Sheets(TBU).Range(Sheets(TBU).Cells(i + 3, 3), Sheets(TBU).Cells(i + 3, 13)).Value
                Sheets(TBU).Range(Sheets(TBU).Cells(i + 3, 3), Sheets(TBU).Cells(i + 3, 13)).ClearContents 'Since the record has been tranferred to TestData clear the import
            End If
        ElseIf Cells(i + 3, 10).Value = 2 Then  'If data line is marked as Unverified
    
        Else  'This should not be triggered...
    
        End If
    Next i
    
UpdateTests
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub




Sub UpdateTests() 'Updates each test that has been moved from Test sorter.
                  'NOTE! This cannot be called alone, it needs ARupdates and LVupdates to be populated before it will work... SortTests populates these public arrays
Dim RowNum As Long, ColNum As Long, TestCount As Long, i As Long
Dim AR As Variant, LV As Variant, Temp As Variant
Dim DataRange As Range

TestCount = ThisWorkbook.Sheets(TD).Cells(Rows.Count, 1).End(xlUp).row


Application.Calculation = xlCalculationManual
Application.EnableEvents = False




For Each AR In ARupdates
    
    RowNum = Application.WorksheetFunction.Match(AR, Sheets(ADB).Range("A1:A99999"), 0)
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 690).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""ROCK2"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 691).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""ROCK1"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 692).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""PKA"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 693).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""AKT1"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 694).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""IKK-b"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 695).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""JAK2"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 696).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""JAK3"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 697).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""PKCh"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 698).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""PKCd"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 699).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""PKCe"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 700).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""TYK2"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 701).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""JAK1"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    
    
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 730).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""PTM_Actin_2"",IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 731).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""HTM_FA"",IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 732).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""ST5"",IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 734).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""NFkB"",IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 736).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(LEFT(TestData!$E$2:$E$" & TestCount & ",3)=""TOX"",IF(ISNUMBER(SEARCH(""BKG"",TestData!$E$2:$E$" & TestCount & "))=FALSE,IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ","""")))))),""-"")"
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 737).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(ISNUMBER(SEARCH(""TNF"",TestData!$E$2:$E$" & TestCount & "))=TRUE,IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    
    
    ThisWorkbook.Sheets(ADB).Cells(RowNum, 750).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""PAMPA"",IF(TestData!$G$2:$G$" & TestCount & "=""XC50"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    'Example format -> ThisWorkbook.Sheets(ADB).Cells(RowNum, 690).FormulaArray = "=IFERROR(MEDIAN(IF(A" & RowNum & "=TestData!$A$2:$A$" & TestCount & ",IF(TestData!$D$2:$D$" & TestCount & "=""ROCK2"",IF(TestData!$G$2:$G$" & TestCount & "=""KI"",IF(TestData!$H$2:$H$" & TestCount & "=5,TestData!$F$2:$F$" & TestCount & ",""""))))),""-"")"
    Set DataRange = ThisWorkbook.Sheets(ADB).Range("ZN" & RowNum & ":AED" & RowNum)
    DataRange.Value = DataRange.Value   'Sets array formulas to values
        
Next AR

The Function in the Functions Module that checks to see if a record exists is below:

Function DoesTestExist(LVial As String, Study As String, Test As String, Metric As String, Uni As String) As Double 'Searches for the test in the TestData and returns the row number if it exists. Returns 0 if no record present.
Dim LastRow As Long, i As Long


LastRow = Sheets(TD).Cells(Rows.Count, 1).End(xlUp).row
For i = 2 To LastRow
    If Cells(i, 11).Value = Uni Then
        If Cells(i, 5).Value = Test Then
            If Cells(i, 3).Value = LVial Then
                If Cells(i, 7).Value = Metric Then
                    If Cells(i, 4).Value = Study Then
                        DoesTestExist = i
                        GoTo Flee
                    End If
                End If
            End If
        End If
    End If
Next i


DoesTestExist = 0
Flee:


End Function

Thank you for looking it over! I don't expect anyone to pour over the code, but I'm a self-taught programmer and would appreciate if any parts of the code are unnecessarily unwieldy or written in a way that will lag the program. I'm concerned with when I'm adding the formulaarrays into the workbook at UpdateTests sub and when the DoesTestExist function runs.

I'd be happy to answer any questions, thanks in advance for your help/adivce!

 

[Kyle123]

Read the whole dataset into an array, loop through that making your changes and then write it back to the sheet in one pass.

Worksheet calls are exceptionally slow and you never want to do them in a loop - looping an array is fast