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.
PR_summary
, then setting theCells(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! \$\endgroup\$ – John Bustos May 23 '19 at 15:21