Using Arrays to Increase Looping Speed

[trux101]

Hello All,
I've got the below code which is working fine but currently is not very efficient. Wondering if anyone knows how I can change this so that it's using arrays? From reading the forum it seems if I use arrays this will be much faster. I have 6 other similar codes to below doing exactly the same thing but looking at different tables in the workbook and going through 80,000 lines. In total it's taking about 20 mins to run!

The aim is to calculate salary increases for employees who are eligible based on various recomended percentages e.g industry views/recruiter views/experts views etc. Below is the example calculating using industry recomended percentages.

Thanks!


Option Explicit</SPAN>

Public Function Salary_Increase()</SPAN>

Dim Ln As Long, x As Long, </SPAN>
Dim Industry_Forecast_Tbl As Variant, Data_Tbl As Variant, Increase_Type_Tbl As Variant</SPAN>
Dim CY_Salary As Variant, PT_Perc As Variant, Staff_Id As Variant, Eligibility_Input As Variant</SPAN>

Dim Scenario_2_Percent As Variant, Scenario_2_FTE As Variant, Scenario_2_Actual As Variant</SPAN>

Industry_Forecast_Tbl = Range("Inflation_Tbl")</SPAN>
Data_Tbl = Range("Data_Tbl")</SPAN>
CY_Salary = Range("Data_Tbl[CY FTE Salary GBP]")</SPAN>
PT_Perc = Range("Data_Tbl[CY Part-Time Percent]")</SPAN>
Staff_Id = Range("Data_Tbl[Staff ID]")</SPAN>
Eligibility_Input = Range("Data_Tbl[Salary Increment Eligibility]")</SPAN>

ReDim Scenario_2_FTE(1 To UBound(Staff_Id), 1 To 1)</SPAN>
ReDim Scenario_2_Actual(1 To UBound(Staff_Id), 1 To 1)</SPAN>
ReDim Scenario_2_Percent(1 To UBound(Staff_Id), 1 To 1)</SPAN>

For Ln = 1 To UBound(Staff_Id)</SPAN>
For x = 1 To UBound(Inflation_Country)</SPAN>

If Eligibility_Input(Ln, 1) = "Eligible" Then</SPAN>
If Data_Tbl(Ln, 14) = Industry_Forecast_Tbl (x, 1) Then</SPAN>

Scenario_2_Percent(Ln, 1) = Industry_Forecast_Tbl (x, 2)</SPAN>
Scenario_2_FTE(Ln, 1) = Industry_Forecast_Tbl (x, 2) * CY_Salary(Ln, 1)</SPAN>
Scenario_2_Actual(Ln, 1) = Industry_Forecast_Tbl (x, 2) * CY_Salary(Ln, 1) * PT_Perc(Ln, 1)</SPAN>

End If</SPAN>
End If</SPAN>

Next x</SPAN>
Next Ln</SPAN>

Range("Data_Tbl[Scenario 2 - Increase %]") = Scenario_2_Percent</SPAN>
Range("Data_Tbl[Scenario 2 -FTE Increase GBP]") = Scenario_2_FTE</SPAN>
Range("Data_Tbl[Scenario 2 -Actual Increase GBP]") = Scenario_2_Actual</SPAN>

End Function</SPAN>

 

[joeu2004]

I've got the below code which is working fine but currently is not very efficient. Wondering if anyone knows how I can change this so that it's using arrays? [....] In total it's taking about 20 mins to run!

The code already uses arrays, and it is quite efficient.

Statements of the form Industry_Forecast_Tbl = Range("Inflation_Tbl") create an array of type Variant and copy the range of values into the array.

Arguably, the for-loop might be faster if you used an array of type Double, Long or String, depending on the data in the range.

We cannot copy the Excel range directly into an array of type Double etc. And in your case, it would not help to copy the array of Variant into an array of Double etc in a for-loop.

But you could use type Double etc in the ReDim'd arrays, to wit:

ReDim Scenario_2_FTE(1 To UBound(Staff_Id), 1 To 1) As Double

Also remove the Dim statement for that variable.

However, that will cause zero to be displayed in rows where Eligibility_Input(Ln, 1) <> "Eligible" or Data_Tbl(Ln, 14) <> Industry_Forecast_Tbl (x, 1).

If you want to see empty cells in those rows, you are correct to ReDim the arrays as type Variant implicitly. (Although I prefer to write "As Variant" explicitly.)

If the double for-loop is the cause of the long execution time, there might be nothing you can do about it, short of implementing a different algorithm. I am not taking the time to understand to your calculations in order to see if a significantly different algorithm or implementation is feasible.

However, that might not be the cause of the long execution time. Instead, the long execution time might be caused by needlessly multiple recalculations resulting from each of the range assignment statements at the end.

(You might confirm that by adding some debugging code to see how the execution time is distributed. See below.)

See if the following makes a significant improvement:

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
Range("Data_Tbl[Scenario 2 - Increase %]") = Scenario_2_Percent
Range("Data_Tbl[Scenario 2 -FTE Increase GBP]") = Scenario_2_FTE
Range("Data_Tbl[Scenario 2 -Actual Increase GBP]") = Scenario_2_Actual
With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

Caveat: That code is not "defensive", as perhaps it should be. If an error occurs that aborts the VBA procedure, the events and calculation modes could be left in a bad state. But that seems unlikely. On the other hand, your Excel design might depend on events remaining enabled during those assignments.

Finally, if you want to understand the distribution of the 20-min execution time, the following debug code might suffice.

Note: There are more precise methods for measuring time. They are appropriate and necessary for short times. But the use of Now() below should be sufficient for an elapsed time of 20 min.

Dim st As Double
st = Now
Industry_Forecast_Tbl  = Range("Inflation_Tbl")
[....]
ReDim Scenario_2_Percent(1 To UBound(Staff_Id), 1 To 1)
Debug.Print "copy-in ranges and redims: " & WorksheetFunction.Text(Now - st, "[m]:ss")
 
st = Now
For Ln = 1 To UBound(Staff_Id)
For x = 1 To UBound(Inflation_Country)
[....]
Next x
Next Ln
Debug.Print "for-loops: " & WorksheetFunction.Text(Now - st, "[m]:ss")

st = Now
Range("Data_Tbl[Scenario 2 - Increase %]") = Scenario_2_Percent
Range("Data_Tbl[Scenario 2 -FTE Increase GBP]") = Scenario_2_FTE
Range("Data_Tbl[Scenario 2 -Actual Increase GBP]") = Scenario_2_Actual
Debug.Print "copy-out ranges: " & WorksheetFunction.Text(Now - st, "[m]:ss")

Since VBA Now has a resolution of 1 sec, it is pointless to use the format "ss.000".

When done, press ctrl-G to open the Immediate Window to see the results of the Debug.Print statements.

 

[trux101]

Thank you so much joeu2004 for the detailed and insightful response! I'll implement the tricks mentioned above to all the code and see what that does to the overall macro speed.