Optimize the speed of vba code

[jharvey_22]

This is my code:

Option Explicit
Dim i As Variant
Dim j As Variant
Dim x As Variant
Dim array1(202, 58) As Variant

Sub Report1()
'First, gather all of the information from the comparison tab
For i = 0 To 202
For j = 0 To 58
array1(i, j) = Worksheets("Comparison").Range("C19").Offset(i, j)
Next j
Next i

'Next, look for errors in the information we just gathered. If there is an error, we will record that
'in the report. Because we know i & j, we know where the error is located in the comparison tab
'using this information, we can easily locate the other information we want for the report

x = 0
For i = 0 To 202
For j = 0 To 58
If IsError(array1(i, j)) Then
x = x + 1
Range("percentchangestart1").Offset(x - 1, 0) = "DIV/0 err" 'this is just a placholder to identify that we have an error
Range("hfmnumber1start").Offset(x - 1, 0) = Worksheets("Comparison").Range("A19").Offset(i, 0) 'since we know the row where the error is, we can look up the HFM # in that row
Range("hfmaccount1start").Offset(x - 1, 0) = Worksheets("comparison").Range("B19").Offset(i, 0) 'since we know the row where the error is, we can look up the HFM account in that row
Range("location1start").Offset(x - 1, 0) = Worksheets("comparison").Range("c15").Offset(0, j) 'since we know the column where the error is, we can look up the entity in that row
End If
Next j
Next i
End Sub



How can I make this faster? It is sooo slow some days. Any help will be much appreciated. Thanks!

 

[Geoff Taylor]

You're defining X as either 0 or 1 and then subtracting 1 from it in every iteration of every range statement. Could you define X as either -1 or 0? Because then your range statement would be Offset(x,0). That would remove several thousand calculations from the routine as it runs.

You could also top & tail your code with
application.screenupdating=false
all your code
application.screenupdating=true

This would not update the display until the code was complete. That's often a timesaver, too.

 

[Jonmo1]

For starters, dim i j and x as LONG, not Variant.

When dimmed as Variant, VBA must do extra "thinking" to decide which datatype to use..


Then, make it only do the loop once..
What is the purpose of loading the values into an array, then looping through the array?

And finally, turn off Events, Calculation and ScreenUpdating...

Try

Option Explicit
Dim i As Long
Dim j As Long
Dim x As Long
 
Sub Report1()
Dim PrevCalc
'Next, look for errors in the information we just gathered. If there is an error, we will record that
'in the report. Because we know i & j, we know where the error is located in the comparison tab
'using this information, we can easily locate the other information we want for the report
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With
x = 0
For i = 0 To 202
    For j = 0 To 58
        If IsError(Worksheets("Comparison").Range("C19").Offset(i, j)) Then
            x = x + 1
            Range("percentchangestart1").Offset(x - 1, 0) = "DIV/0 err" 'this is just a placholder to identify that we have an error
            Range("hfmnumber1start").Offset(x - 1, 0) = Worksheets("Comparison").Range("A19").Offset(i, 0) 'since we know the row where the error is, we can look up the HFM # in that row
            Range("hfmaccount1start").Offset(x - 1, 0) = Worksheets("comparison").Range("B19").Offset(i, 0) 'since we know the row where the error is, we can look up the HFM account in that row
            Range("location1start").Offset(x - 1, 0) = Worksheets("comparison").Range("c15").Offset(0, j) 'since we know the column where the error is, we can look up the entity in that row
        End If
    Next j
Next i
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With
End Sub

 

[AlphaFrog]

Yet another way (not tested).

Sub Report1()
    
    Dim x As Long
    Dim cell As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With Worksheets("Comparison")
        ' loop for each error in range
        For Each cell In .Range("C19").Resize(203, 59).SpecialCells(xlErrors)
            Range("percentchangestart1").Offset(x) = "DIV/0 err"           'this is just a placholder to identify that we have an error
            Range("hfmnumber1start").Offset(x) = .Range("A" & cell.Row)    'since we know the row where the error is, we can look up the HFM # in that row
            Range("hfmaccount1start").Offset(x) = .Range("B" & cell.Row)   'since we know the row where the error is, we can look up the HFM account in that row
            Range("location1start").Offset(x) = .Cells(15, cell.Column)    'since we know the column where the error is, we can look up the entity in that row
            x = x + 1
        Next cell
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

 

[jharvey_22]

You guys are awesome! I got JonMo's code to work and it is years quicker than my original. One follow up question for learning as I am new to VBA: Can you explain the what these do?

With Application
.ScreenUpdating = False
.EnableEvents = False
PrevCalc = .Calculation
.Calculation = xlCalculationManual
End With

I know what ScreenUpdating does but not sure on the others.

Again thank you so much for the quick replies and the help. You saved me quite a bit of time.

 

[AlphaFrog]

Correction (for what it's worth)

In my code, this...

For Each cell In .Range("C19").Resize(203, 59).SpecialCells(xlErrors)

Should be this...

For Each cell In .Range("C19").Resize(203, 59).SpecialCells([COLOR="Red"]xlCellTypeFormulas,[/COLOR] xlErrors)