Loop through Array with Nested Ifs Faster

Question

I have an array of data on one worksheet. I need to loop through the array, evaluate each row based on certain criteria, and then take the criteria matched rows and copy them over to another worksheet. I wrote the following code to do this process.

However, the loop takes too long. It takes about 5 minutes to run. I need it to run in less than 30 seconds. I read the following q on SO: What is the most efficient/quickest way to loop through rows in VBA (excel)? and that lead me to create the array. I also tried to keep the code simple. I turn off screenupdating and enableevents.

What can I do to make this process faster? Thank you for your help.

Sub tester()

Dim vData() As Variant
Dim R As Long
Dim C As Long
Dim LastRow1 As Long
Dim rng1 As Range, rng2 As Range

Set sh3 = Sheets("ABC")
Set sh5 = Sheets("XYZ")

Application.ScreenUpdating = False
Application.EnableEvents = False

LastRow1 = sh3.Cells(Rows.Count, "A").End(xlUp).Row
vData = Range("A1:N" & LastRow1).Value

sh5.Range("B3:AV10000").ClearContents

For R = 1 To UBound(vData, 1)
    For C = 1 To UBound(vData, 2)
        If sh3.Cells(R, "G").Value <= Date Then 'if date is prior to today then
            If sh3.Cells(R, "J").Value = "C" Then
                If sh3.Cells(R, "D").Value > 0 Then
                    If sh3.Cells(R, "I").Value >= sh3.Cells(R, "H").Value Then
                        Set rng1 = sh3.Range("A" & R & ":N" & R)
                        Set rng2 = sh5.Range("B" & R & ":O" & R)
                        rng1.Copy rng2
                    Else
                        Set rng3 = sh3.Range("A" & R & ":N" & R)
                        Set rng4 = sh5.Range("B" & R & ":O" & R)
                        rng3.Copy rng4
                    End If
                ElseIf sh3.Cells(R, "D").Value < 0 Then
                    If sh3.Cells(R, "I").Value >= sh3.Cells(R, "H").Value Then
                        Set rng5 = sh3.Range("A" & R & ":N" & R)
                        Set rng6 = sh5.Range("B" & R & ":O" & R)
                        rng5.Copy rng6
                    Else
                        Set rng7 = sh3.Range("A" & R & ":N" & R)
                        Set rng8 = sh5.Range("B" & R & ":O" & R)
                        rng7.Copy rng8
                    End If
                End If
            End If
        End If
    Next C
Next R

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Answer 1

Also - you're losing a lot of the time saving array functionality by making frequent calls back to the api. Example:

 if sh3.Cells(R, "G").Value  

should be the same thing as

 if vData(R,7)  

You probably don't need the loop

 For C = 1 to ubound(vData,2)
 Next C

You're not referencing it anywhere and it's gonna exponentially increase the number of instructions.

Try stepping through your code using f8 with your locals window open and watch what happens to the variables that you've declared for further detail.

You should manipulate the values inside of the array versus on the worksheet, just at the end of the procedure you can replace the activesheet values in one instruction versus doing that within the loop

Just be cautious that your formats will not carry into your array "vData", it's only setting the .value of the usedrange, hence formatting will drop, and variant data type vData will grab the closest apparent data type. What this means is when something looks like a number if it has leading zeros even if it is text after you drop it into the worksheet you lose those leading zeros a way around that is to format the cells prior to setting the values within the api otherwise excel just does what it does best, I like to use something like

 sh5.cells.NumberFormat = "@" 

Answer 2

As per my comment, try using Application.Calculation = xlCalculationManual and Application.DisplayAlerts = False to speed things up.

Just be sure to put Application.Calculation = xlCalculationAutomatic and Application.DisplayAlerts = True at the end :)