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

Two more Application related tips to help performance are Application.Calculation = xlCalculationManual and Application.DisplayAlerts = False. But in your case I'm not sure those would help a whole lot — TheGuyThatDoesn'tKnowMuch
– TheGuyThatDoesn'tKnowMuch, Commented Jun 8, 2016 at 12:20
Dude! Application.Calculation = xlCalculationManual worked. Took it from 5+ minutes to <10 seconds. Why is that??? I hadn't added that because I thought looping through an Array only looked at values, not formulas, so preventing calculations would be meaningless. — tulanejosh
– tulanejosh, Commented Jun 8, 2016 at 12:24
Combine your If statements with And and use a For Each loop to loop through the rows you want to evaluate. — Brian
– Brian, Commented Jun 8, 2016 at 12:26
Just be sure to put at the end Application.Calculation = xlCalculationAutomatic, otherwise whenever you manually enter a formula and copy it, it will paste the original result each time. Same with DisplayAlerts (=True) — TheGuyThatDoesn'tKnowMuch
– TheGuyThatDoesn'tKnowMuch, Commented Jun 8, 2016 at 12:28

TheGuyThatDoesn'tKnowMuch · Accepted Answer · 2016-06-08 12:42:12Z

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 :)

answered Jun 8, 2016 at 12:42

TheGuyThatDoesn'tKnowMuch

1,2502 gold badges17 silver badges29 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

Clyde · Accepted Answer · 2016-06-08 13:12:02Z

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 = "@"

Collectives™ on Stack Overflow

Loop through Array with Nested Ifs Faster

2 Answers 2

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related