HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Cycle through a table to find the cheapest bearing that passes

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
cyclethebearingthroughcheapestpassesthatfindtable

Problem

Follow-up to VBA macro - searches through a filtered table, stops when entry passes criteria

I have written several VBA macros to run on an Excel spreadsheet. Inputs are entered into a table and then the macro is run. It cycles through a table of Bearings (in price ascending order) and selects the first one to pass all the criteria.

At the moment there are about 1700 rows in the table and it takes approx. 35 seconds to cycle through them all. Just wondering if there's any improvements I can make to my code to increase the efficiency. I have posted a similar question before and the code shown below has been improved since then.

```
Sub FindBearing()
Dim InputWS As Worksheet
Set InputWS = Sheets("Input")

Dim CalcWS As Worksheet
Set CalcWS = Sheets("Calculations")

Dim TempWS As Worksheet
Set TempWS = ThisWorkbook.Sheets.Add

CalcWS.Unprotect Password:="Unlock"
Application.ScreenUpdating = False

ClearFilters CalcWS
SetZerosToNA InputWS
OverallDimensionFilter InputWS, CalcWS
PasteFilteredTableToTempSheet TempWS, CalcWS
FindBearingFromFilteredTable TempWS, CalcWS
DeleteTempSheet TempWS
ClearFilters CalcWS
InputWS.Activate

Application.ScreenUpdating = True
CalcWS.Protect Password:="Unlock"

End Sub

Sub FindUnfixedBearing()
Dim InputWS As Worksheet
Set InputWS = Sheets("Input")

Dim CalcWS As Worksheet
Set CalcWS = Sheets("Calculations")

Dim TempWS As Worksheet
Set TempWS = ThisWorkbook.Sheets.Add

CalcWS.Unprotect Password:="Unlock"
Application.ScreenUpdating = False

ClearFilters CalcWS
SetZerosToNA InputWS
OverallDimensionFilter InputWS, CalcWS
PasteFilteredTableToTempSheet TempWS, CalcWS
FindUnfixedBearingFromFilteredTable TempWS, CalcWS
DeleteTempSheet TempWS
ClearFilters CalcWS
InputWS.Activate

Application.ScreenUpdating = True
CalcWS.Protect Password:="Unlock"

End Sub

Sub ClearFilters(ByRef CalcWS As Worksheet)

Dim Full_Bearings_List As ListObject

If

Solution

It seems you didn't include Option Explicit at the top of the module. You always want to do that so you ensure all your variables are declared. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option.

Wonderfully, you have defined all your variables. Good work!

Structure

But your indenting is all.. not indented. Try to make it consistently indented so levels can be seen and labels will stick out. You have a little bit of excess white space, but I can't say that's a real problem. For instance

Sub DimensionFilterTransverse3(ByRef CalcWS As Worksheet, ByRef InputWS As Worksheet)

Sheets("Calculations").Range("X8").AutoFilter Field:=2, Criteria1:=">=" & Sheets("Input").Range("F31").Value

End Sub


looks cleaner as

Sub DimensionFilterTransverse2(ByRef CalcWS As Worksheet, ByRef InputWS As Worksheet)
    Sheets("Calculations").Range("X8").AutoFilter Field:=2, Criteria1:="<=" & Sheets("Input").Range("F34").Value
End Sub


ByRef

I see pretty much all of your arguments are passed ByRef. What you probably want to do is declare Functions that take arguments ByVal and return a reference you want or you don't need ByRef at all. Take this for example -

Sub DimensionFilterLongitudinal2(ByRef CalcWS As Worksheet, ByRef InputWS As Worksheet)
    Sheets("Calculations").Range("X8").AutoFilter Field:=3, Criteria1:="<=" & Sheets("Input").Range("F35").Value
End Sub


You take arguments but you don't use them. Rather you'd like to do this

Private Sub DimenstionFilterEtc(ByVal calculationRange As Range, ByVal inputRange As Range)
    calculationRange.AutoFilter field:=3, Criteria1:=">=" & inputRange.Value
End Sub


For pretty much all of your subs you pass arguments and don't use them. I think what happened is that you misunderstood how these arguments work.

Say you want to change something on Sheet1 every time. Well, you don't need to pass that as a reference to the function, the function already has access to that sheet because it's publicly available to it -

Private Sub EditSheet()
    Sheet1.ClearFormatting
end Sub


But if you wanted to use that to change different sheets, then you need the argument -

Private Sub EditSheet(ByVal targetSheet as Worksheet)
    targetSheet.ClearFormatting
end Sub


Now whatever sheet you pass will be edited, and will remain edited after the routine finishes.

Passing ByVal means that you are sending (a copy of) what it actually is as the argument. If you send it ByRef you send a it to it instead, and anything that happens to that reference carries back. For example -

Sub main()
    Dim i As Long
    i = 2
    Dim j As Long
    j = addVal(i)
    'j = 6, i = 2
    j = AddRef(i)
    'j = 4, i = 6
End Sub
Private Function addVal(ByVal i As Long) As Long
    If i > 1 Then i = i + 2
    addVal = i + 2
End Function
Private Function AddRef(ByRef i As Long) As Long
    If i > 1 Then i = i + 2
    AddRef = i + 2
End Function


Changes made ByRef stick with you after the procedure ends rather than on just a copy, leaving your original as it should be.

Code Snippets

Sub DimensionFilterTransverse3(ByRef CalcWS As Worksheet, ByRef InputWS As Worksheet)

Sheets("Calculations").Range("X8").AutoFilter Field:=2, Criteria1:=">=" & Sheets("Input").Range("F31").Value

End Sub
Sub DimensionFilterTransverse2(ByRef CalcWS As Worksheet, ByRef InputWS As Worksheet)
    Sheets("Calculations").Range("X8").AutoFilter Field:=2, Criteria1:="<=" & Sheets("Input").Range("F34").Value
End Sub
Sub DimensionFilterLongitudinal2(ByRef CalcWS As Worksheet, ByRef InputWS As Worksheet)
    Sheets("Calculations").Range("X8").AutoFilter Field:=3, Criteria1:="<=" & Sheets("Input").Range("F35").Value
End Sub
Private Sub DimenstionFilterEtc(ByVal calculationRange As Range, ByVal inputRange As Range)
    calculationRange.AutoFilter field:=3, Criteria1:=">=" & inputRange.Value
End Sub
Private Sub EditSheet()
    Sheet1.ClearFormatting
end Sub

Context

StackExchange Code Review Q#135942, answer score: 2

Revisions (0)

No revisions yet.