# Calculations for trucks

How can I improve my VBA code to run faster?

The issue I'm having is that the For/Next commands are taking ~10 hours to calculate and print all of the data. I cannot turn of calculations because I need the values calculated for every node (check_nodes).

I have 1 sheet ("Rating") that performs calculations (25) for every check_node (944 nodes) of all check_trucks (38 trucks) so that's $$\25\times944\times38=896800\$$ data points that are compiled then printed to different sheets for each of the 38 trucks. The results & format I'm getting are correct I just need to speed up the code somehow.

Originally I was going to run the VBA individually for all 38 trucks but then decided to modify the code to run all trucks automatically. Unfortunately this increased run time dramatically.

Sub Perform_Rating_Check()

Dim StartTime As Double
Dim SecondsElapsed As Double

'Remember time when macro starts
StartTime = Timer

'------------------------
'DETERMINE NUMBER OF ROWS OF DATA FOR LOAD RATING SUMMARY
'------------------------

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Sheets("Output").Activate
Row = Range("Start.Nodes").Row
Column = Range("Start.Nodes").Column

startRow = Range("Start.Nodes").Row
nrows = Range("Num_Checks").Value

ReDim check_nodes(1 To nrows)
For q = 1 To nrows
check_nodes(q) = Cells(startRow - 1 + q, Column)
Next

'------------------------------
'------------------------------

ReDim PR_summary(1 To nrows, 1 To 26)

Sheets("Rating").Activate
Truck_row = Range("Start.Truck").Row
Truck_col = Range("Start.Truck").Column

ntrucks = Range("Num.Trucks").Value

ReDim check_trucks(1 To ntrucks)
For k = 1 To ntrucks
check_trucks(k) = Cells(Truck_row - 1 + k, Truck_col)
Next

For j = 1 To ntrucks
TruckSheet = check_trucks(j)
Range("Choose.Truck") = check_trucks(j)
Sheets(TruckSheet).Activate
For s = 1 To nrows
Range("Check_Location") = check_nodes(s)
PR_row = Range("A9").Row - 1
PR_col = Range("A9").Column - 1
Cells(PR_row + s, PR_col + 1) = check_nodes(s)
Cells(PR_row + s, 2) = Range("RF_INV_Axial").Value
Cells(PR_row + s, 3) = Range("RF_INV_Major").Value
Cells(PR_row + s, 4) = Range("RF_INV_Minor").Value
Cells(PR_row + s, 5) = Range("RF_OPR_Axial").Value
Cells(PR_row + s, 6) = Range("RF_OPR_Major").Value
Cells(PR_row + s, 7) = Range("RF_OPR_Minor").Value
Cells(PR_row + s, 8) = Range("RF_INV_Axial_My").Value
Cells(PR_row + s, 9) = Range("RF_INV_Major_My").Value
Cells(PR_row + s, 10) = Range("RF_INV_Minor_My").Value
Cells(PR_row + s, 11) = Range("RF_OPR_Axial_My").Value
Cells(PR_row + s, 12) = Range("RF_OPR_Major_My").Value
Cells(PR_row + s, 13) = Range("RF_OPR_Minor_My").Value
Cells(PR_row + s, 14) = Range("RF_INV_Axial_Mz").Value
Cells(PR_row + s, 15) = Range("RF_INV_Major_Mz").Value
Cells(PR_row + s, 16) = Range("RF_INV_Minor_Mz").Value
Cells(PR_row + s, 17) = Range("RF_OPR_Axial_Mz").Value
Cells(PR_row + s, 18) = Range("RF_OPR_Major_Mz").Value
Cells(PR_row + s, 19) = Range("RF_OPR_Minor_Mz").Value
Cells(PR_row + s, 20) = Range("RF_INV_Shear_P").Value
Cells(PR_row + s, 21) = Range("RF_INV_Shear_My").Value
Cells(PR_row + s, 22) = Range("RF_INV_Shear_Mz").Value
Cells(PR_row + s, 23) = Range("RF_OPR_Shear_P").Value
Cells(PR_row + s, 24) = Range("RF_OPR_Shear_My").Value
Cells(PR_row + s, 25) = Range("RF_OPR_Shear_Mz").Value
Next s
Next j

'Determine how many seconds code took to run
SecondsElapsed = Round(Timer - StartTime, 2)

'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub


I like how the data is printed currently but I just want it to run much faster. Last time I ran the code it took about 10 hours to complete.

• Possible duplicate of How To Speed Up VBA Code May 23, 2019 at 15:14
• 2 things seem off to me, but it may be related to other cells in your sheet: 1) You are setting PR_summary, then setting the Cells(PR_row + s) to its value, why not just miss out the PR_Summary and set the cells right away? 2) MUCH more importantly, if you could, can you switch off the calculation for as much as possible? I'm wiling to bet that if you did that, your code will run MUCH faster! May 23, 2019 at 15:21
• Did you try reverting the nesting of the loops? (meaning, making the inner loop to be the outer and vise-versa).
– FDavidov
May 23, 2019 at 15:22
• @JohnBustos I need the "Rating" sheet to recalculate the PR_summary values for all check_nodes. Wouldn't turning off calculation make all of the PR_summary values identical? Would setting the cells right away look something like this Cells(PR_row + s, 1) = Range("RF_INV_Axial").Value instead?
– tuckman321
May 23, 2019 at 15:25
• @JohnBustos, I'm not sure if my recollection is correct... Automatic recalculation is not triggered till the macro ends (it makes no sense to recalculate the whole book each update of a cell).
– FDavidov
May 23, 2019 at 15:26

It's not super-clear to me what's going on here but this stands out as cell-by-cell data transfer, which is pretty slow:

   For s = 1 To nrows
Range("Check_Location") = check_nodes(s)
PR_row = Range("A9").Row - 1      '<< why not just =8?
PR_col = Range("A9").Column - 1   '<<     and = 0 ?
Cells(PR_row + s, PR_col + 1) = check_nodes(s)
Cells(PR_row + s, 2) = Range("RF_INV_Axial").Value
Cells(PR_row + s, 3) = Range("RF_INV_Major").Value
'etc etc
Cells(PR_row + s, 25) = Range("RF_OPR_Shear_Mz").Value
Next s


Would be faster if you set all 25 values in a single call:

   For s = 1 To nrows
Range("Check_Location") = check_nodes(s)
PR_row = Range("A9").Row - 1      '<< why not just =8?
PR_col = Range("A9").Column - 1   '<<     and = 0 ?
Cells(PR_row + s, PR_col + 1).resize(1,25).value = _
Array(check_nodes(s), Range("RF_INV_Axial").Value, _
Range("RF_INV_Major").Value,{etc etc} ,Range("RF_OPR_Shear_Mz").Value)
Next s


Also as John suggests, switch calculation to Manual, and call Calculate on your formulas sheet when you're ready for the next set of values to be created.

You are missing Option Explicit at the top of your code module. Add it. From the menu Tools>Options to display the Options dialog.

In the Options dialog>Editor tab>Code Settings group>Require Variable Declaration ensure it has a check mark next to it.

Your future-self will thank you for doing so. This mandates you declare any variables Dim foo as Long before you can use them anywhere in your code foo = 10. You will save yourself so much frustration by doing this.

You're using unqualified Ranges objects. This leads to a two-fold issue. First what is an unqualified Range? Range("Foo") instead of specifiedSheet.Range("Foo"). By not fully qualifying the sheet the range is using whatever-happens-to-be the ActiveSheet to get that Range. This is a problem because you then need to use Worksheet.Activate method to first activate the sheet then hope/pray/wish that another sheet doesn't get activated while your code is running. Activating a sheet is a liability and isn't needed.

An example of this is the ambiguity it causes with named ranges. Is Range("Start.Nodes") scoped to the worksheet that is active or is it scoped to the workbook? I can't tell from the code itself. My refactoring is going to assume that they are scoped to a worksheet.

You are using the default member of the Range object. What's this? Using specifiedSheet.Range() or specifiedSheet.Cells(,) instead of specifiedSheet.Range().Value2. In the first you're implicitly using it to get the value of the cell, the second it's explicitly shown. You can see this in the Object Browser, shown by pressing F2 in the VBE. Making sure hidden members are shown and navigating to the Range class then to Default. The teal icon indicates it's the default member.

If your curious why Value2 is used read up on TEXT vs VALUE vs VALUE2 – Slow TEXT and how to avoid it by Charles Williams.

You have comment block style headers.

'------------------------
'DETERMINE NUMBER OF ROWS OF DATA FOR LOAD RATING SUMMARY
'------------------------


Comments should say why somethings done that way. The what should be apparent by using adequately descriptive names. This applies to all names whether they are for a variable, Function, Sub, etc. A clear name that states what it is, or is doing makes your code self-documenting. You have an example of this with your variables. Dim startRow as Long states that it is the start row. Then you also have q, k, j, s, nrows, etc. That's not helping readability at all.

You can also create a specific function and return what it's named. This lets you break down the steps into small modular pieces. An example follows.

Private Function GetCheckNodes(ByVal topLeftCell As Range, ByVal numberOfRows As Long) As Variant
GetCheckNodes = Application.WorksheetFunction.Transpose(topLeftCell.Resize(numberOfRows, 1))
End Function


Application.WorksheetFunction.Transpose is used to transpose the array from a 2D array to a 1D array. Where this function is used you provide arguments to the parameters.

Dim checkNodes As Variant
checkNodes = GetCheckNodes(outputSheet.Range("Start.Nodes"), numberOfRows)


Be sure to limiting the information that's provided to these function to only what it actually needs to know in order to achieve the task. This takes a bit of refactoring and examining what the code is or should be doing but in the long run helps clear things up a lot.

When you have contiguous ranges that span multiple rows or columns don't pick up each one individually. Think of a bag marbles on the counter top and picking them up one at a time. That's what you're doing. Since you know the start and end rows you ---can--- should get the entire range all at once and store it in a variable. The example refactoring above shows just this. You originally had

ReDim check_nodes(1 To nrows)
For q = 1 To nrows
check_nodes(q) = Cells(startRow - 1 + q, Column)
Next


Rewritten as topLeftCell.Resize(numberOfRows, 1). It uses the Range.Resize property to resize the range selection and get it in a single step. Instead of picking up 1, 5, 100, or 10,000 cells you get a single range object. Much faster.

You use underscores _ in variable names. This is the convention that you use when an object implements an interface done by using the Implements statement.

These were caught after my refactoring with https://github.com/rubberduck-vba/Rubberduck, of which I'm a contributing member:

Your Sub statement for Sub Perform_Rating_Check() doesn't have an access modifier. Because of this it is implicitly public.

Your calls to Sheets are implicitly referencing the ActiveWorkbook.

Taking all the above into consideration I came up with the below code. The variable names are descriptive and let you know what they are for. There are subs that are specialized to do one thing, and only that one thing.

As I'm not sure about your named ranges I assumed they were on specific sheets. If that's wrong and they're scoped to the workbook then ThisWorkbook.Range("foo") will get them working.

Option Explicit

Const lowerBoundColumnTransfer As Long = 1
Const upperBoundColumnTransfer As Long = 25

Public Sub PerformRatingCheck()
Dim StartTime As Double
StartTime = Timer

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Dim outputSheet As Worksheet
Set outputSheet = ThisWorkbook.Sheets("Output") 'Can be referred to by its code name

Dim numberOfRows As Long
numberOfRows = outputSheet.Range("Num_Checks").Value2

Dim checknodes As Variant
checknodes = GetCheckNodes(outputSheet.Range("Start.Nodes"), numberOfRows)

Dim ratingSheet As Worksheet
Set ratingSheet = ThisWorkbook.Sheets("Rating") 'Can be referred to by its code name

Dim numberOfTrucks As Long
numberOfTrucks = ratingSheet.Range("Num.Trucks").Value2

Dim namesOfTruckSToCheck As Variant
namesOfTruckSToCheck = GetNamesOfTrucksToCheck(ratingSheet.Range("Start.Truck"), ratingSheet.Range("Num.Trucks").Value2)

Dim truckName As Variant
For Each truckName In namesOfTruckSToCheck
PopulateTruckSheet ThisWorkbook.Sheets(truckName), checknodes
Next

Dim SecondsElapsed As Double
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

Private Function GetCheckNodes(ByVal topLeftCell As Range, ByVal numberOfRows As Long) As Variant
GetCheckNodes = Application.WorksheetFunction.Transpose(topLeftCell.Resize(numberOfRows, 1))
End Function

Private Function GetNamesOfTrucksToCheck(ByVal firstTruckCell As Range, ByVal numberOfTrucks As Long) As Variant
GetNamesOfTrucksToCheck = firstTruckCell.Resize(numberOfTrucks, 1).Value2
End Function

Private Sub PopulateTruckSheet(ByVal truckSheet As Worksheet, ByVal checknodes As Variant)
'Unable to definitively determine which sheet named range is on.
'Assuming it's on scoped to each worksheet. If scoped to workbook
'replace truckSheet with Thisworkbook
truckSheet.Range("Choose.Truck").Value2 = truckSheet.Name

Dim truckInfo As Variant
truckInfo = GetTruckInformation(truckSheet, checknodes)

Const PR_row As Long = 8
Dim populationArea As Range
Set populationArea = truckSheet.Cells(PR_row + 1, 1).Resize(UBound(truckInfo), UBound(truckInfo, 2))
populationArea.Value2 = truckInfo
End Sub

Private Function GetTruckInformation(ByVal sourceSheet As Worksheet, ByVal checknodes As Variant) As Variant
Dim tempArray As Variant
ReDim tempArray(LBound(checknodes) To UBound(checknodes), lowerBoundColumnTransfer To upperBoundColumnTransfer)

Dim counter As Long
For counter = LBound(checknodes) To UBound(checknodes)
Dim checkNode As String
checkNode = checknodes(counter)
sourceSheet.Range("Check_Location").Value2 = checkNode

Dim truckInfoForRow As Variant
truckInfoForRow = GetTruckInformationForRow(sourceSheet, checkNode)

Dim columnTransfer As Long
For columnTransfer = lowerBoundColumnTransfer To upperBoundColumnTransfer
tempArray(counter, columnTransfer) = truckInfoForRow(columnTransfer)
Next
Next counter

GetTruckInformation = tempArray
End Function

Private Function GetTruckInformationForRow(ByVal sourceSheet As Worksheet, ByVal checkNode As String) As Variant
'If these are workbook scoped named ranges the parameter sourceSheet can be deleted
Dim tempArray As Variant
ReDim tempArray(lowerBoundColumnTransfer To upperBoundColumnTransfer)
tempArray(1) = checkNode
tempArray(2) = sourceSheet.Range("RF_INV_Axial").Value2
tempArray(3) = sourceSheet.Range("RF_INV_Major").Value2
tempArray(4) = sourceSheet.Range("RF_INV_Minor").Value2
tempArray(5) = sourceSheet.Range("RF_OPR_Axial").Value2
tempArray(6) = sourceSheet.Range("RF_OPR_Major").Value2
tempArray(7) = sourceSheet.Range("RF_OPR_Minor").Value2
tempArray(8) = sourceSheet.Range("RF_INV_Axial_My").Value2
tempArray(9) = sourceSheet.Range("RF_INV_Major_My").Value2
tempArray(10) = sourceSheet.Range("RF_INV_Minor_My").Value2
tempArray(11) = sourceSheet.Range("RF_OPR_Axial_My").Value2
tempArray(12) = sourceSheet.Range("RF_OPR_Major_My").Value2
tempArray(13) = sourceSheet.Range("RF_OPR_Minor_My").Value2
tempArray(14) = sourceSheet.Range("RF_INV_Axial_Mz").Value2
tempArray(15) = sourceSheet.Range("RF_INV_Major_Mz").Value2
tempArray(16) = sourceSheet.Range("RF_INV_Minor_Mz").Value2
tempArray(17) = sourceSheet.Range("RF_OPR_Axial_Mz").Value2
tempArray(18) = sourceSheet.Range("RF_OPR_Major_Mz").Value2
tempArray(19) = sourceSheet.Range("RF_OPR_Minor_Mz").Value2
tempArray(20) = sourceSheet.Range("RF_INV_Shear_P").Value2
tempArray(21) = sourceSheet.Range("RF_INV_Shear_My").Value2
tempArray(22) = sourceSheet.Range("RF_INV_Shear_Mz").Value2
tempArray(23) = sourceSheet.Range("RF_OPR_Shear_P").Value2
tempArray(24) = sourceSheet.Range("RF_OPR_Shear_My").Value2
tempArray(25) = sourceSheet.Range("RF_OPR_Shear_Mz").Value2

GetTruckInformationForRow = tempArray
End Function


There may be more that can be done I've already speculated too much regarding your named ranges.