patternMinor
VBA macro - searches through a filtered table, stops when entry passes criteria
Viewed 0 times
entrycriteriapassesmacrostopsthroughwhensearchesvbatable
Problem
I have written several subs which are then called from a main sub. Individual subs run very quickly, most are instantaneous (the DoFind sub takes a few seconds to run due to the large amounts of data in the table) however when I run the main sub it takes up to a minute to execute. Any ideas/tips on why this is the case?
Note, I haven't had much experience with VBA (all has been learnt in the past week). There are other macros used, but they are not shown since even the test sub takes approximately 1 minute
``
Note, I haven't had much experience with VBA (all has been learnt in the past week). There are other macros used, but they are not shown since even the test sub takes approximately 1 minute
``
Sub DoFind()
Dim i As Long
i = 1
Do While Sheets("Temp").Cells(i, "A").Value <> Empty
Dim BearingArray(6) As String
BearingArray(0) = Sheets("Temp").Cells(i, "A").Value
BearingArray(1) = Sheets("Temp").Cells(i, "B").Value
BearingArray(2) = Sheets("Temp").Cells(i, "C").Value
BearingArray(3) = Sheets("Temp").Cells(i, "D").Value
BearingArray(4) = Sheets("Temp").Cells(i, "E").Value
BearingArray(5) = Sheets("Temp").Cells(i, "F").Value
BearingArray(6) = Sheets("Temp").Cells(i, "G").Value
With Sheets("Calculations")
.Cells(17, "K").Value = BearingArray(0)
.Cells(19, "O").Value = BearingArray(1)
.Cells(20, "O").Value = BearingArray(2)
.Cells(23, "O").Value = BearingArray(3)
.Cells(22, "O").Value = BearingArray(4)
.Cells(26, "O").Value = BearingArray(5)
.Cells(17, "L").Value = BearingArray(6)
End With
i = i + 1
If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
Else
End If
Loop
If Sheets("Temp").Cells(i, "A").Value = Empty Then
MsgBox "No available bearing."
End If
End Sub
Solution
First, I'd just like to say: This is decent code for someone who's brand new to VBA. Great work.
That aside, let's begin:
Option Explicit
If that's not at the top of all your code modules, put it in. Go to Tools --> Options --> Require Variable Declaration to have it auto-inserted into every new module you create.
Easy Performance Improvements
Each of those settings will provide large performance improvements. Especially
Consistent Indenting
Pick an indenting rule and stick to it. Personally, I use a single Tab for each logical level (
Something like this is particularly confusing:
It's much easier to "see" what's going on when it's expressed like this:
I would re-indent your
Much easier to follow.
Naming
I recommend the Excellent, Classic article on naming by Joel spolsky.
Naming is, famously, one of the 2 hardest things in software development. It's also one of the most important. Code should be written for other people (including future you) to understand as easily and completely as possible.
Names should be descriptive, then unambiguous, and only then concise.
Variables should sound like what they are. I should be able to tell from the name of a Sub/Function exactly what it does.
Use the Object Model
The great power of VBA for manipulating MS Office is the extensive Object Model it's integrated with.
There are objects for everything.
Take this for instance:
What happens if/when your temp sheet has a different name than "Temp"? How about if someone renames the "Calculations" sheet? Not only will your code break, but you'll have to change those strings everywhere in your code. Maybe you'll get them all. Ma
That aside, let's begin:
Option Explicit
If that's not at the top of all your code modules, put it in. Go to Tools --> Options --> Require Variable Declaration to have it auto-inserted into every new module you create.
Easy Performance Improvements
Sub DoThing()
With Application
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = False
.Calculation = xlCalculationManual
End With
...
...
Code
...
...
With Application
.ScreenUpdating = True
.EnableEvents = True
.StatusBar = True
.Calculation = xlCalculationAutomatic
End With
End SubEach of those settings will provide large performance improvements. Especially
ScreenUpdating. Always check that you're not reliant on the thing you're disabling though. For instance, DoFind() is relying on a formula to change, so you shouldn't disable Calculation.Consistent Indenting
Pick an indenting rule and stick to it. Personally, I use a single Tab for each logical level (
If, While, With, etc.) and it's a widespread convention with VBA. This way, I can easily identify which statements are operating at what level.Something like this is particularly confusing:
If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
Else
End IfIt's much easier to "see" what's going on when it's expressed like this:
If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
End IfI would re-indent your
DoFind sub like so:Sub DoFind()
Dim i As Long
i = 1
Do While Sheets("Temp").Cells(i, "A").Value <> Empty
Dim BearingArray(6) As String
BearingArray(0) = Sheets("Temp").Cells(i, "A").Value
BearingArray(1) = Sheets("Temp").Cells(i, "B").Value
BearingArray(2) = Sheets("Temp").Cells(i, "C").Value
BearingArray(3) = Sheets("Temp").Cells(i, "D").Value
BearingArray(4) = Sheets("Temp").Cells(i, "E").Value
BearingArray(5) = Sheets("Temp").Cells(i, "F").Value
BearingArray(6) = Sheets("Temp").Cells(i, "G").Value
With Sheets("Calculations")
.Cells(17, "K").Value = BearingArray(0)
.Cells(19, "O").Value = BearingArray(1)
.Cells(20, "O").Value = BearingArray(2)
.Cells(23, "O").Value = BearingArray(3)
.Cells(22, "O").Value = BearingArray(4)
.Cells(26, "O").Value = BearingArray(5)
.Cells(17, "L").Value = BearingArray(6)
End With
i = i + 1
If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
End If
Loop
If Sheets("Temp").Cells(i, "A").Value = Empty Then
MsgBox "No available bearing."
End If
End SubMuch easier to follow.
Naming
I recommend the Excellent, Classic article on naming by Joel spolsky.
Naming is, famously, one of the 2 hardest things in software development. It's also one of the most important. Code should be written for other people (including future you) to understand as easily and completely as possible.
Names should be descriptive, then unambiguous, and only then concise.
Variables should sound like what they are. I should be able to tell from the name of a Sub/Function exactly what it does.
DoFind. This tells me nothing.FindBearing would be better. I'd offer you an even better name, but there's not enough context to be sure what the rest of your code/workbook is doing and why.Create_Sheet_Temp. Don't use _ in procedure names. _ in VBA is used for event triggers e.g. Workbook_Open or Button_OnClick. Avoid it in your own names to avoid confusion.Copy_Paste. Useless. Copy what? Paste what? Paste where?. PasteBearingDataToTempSheet. Sure, it's a bit verbose, but it's also useful. You should always aim for useful names. If you can make them short as well, great, but it's not the priority.Use the Object Model
The great power of VBA for manipulating MS Office is the extensive Object Model it's integrated with.
There are objects for everything.
Workbooks, Worksheets, ListObjects, Ranges etc.Take this for instance:
BearingArray(0) = Sheets("Temp").Cells(i, "A").Value
BearingArray(1) = Sheets("Temp").Cells(i, "B").Value
BearingArray(2) = Sheets("Temp").Cells(i, "C").Value
BearingArray(3) = Sheets("Temp").Cells(i, "D").Value
BearingArray(4) = Sheets("Temp").Cells(i, "E").Value
BearingArray(5) = Sheets("Temp").Cells(i, "F").Value
BearingArray(6) = Sheets("Temp").Cells(i, "G").ValueWhat happens if/when your temp sheet has a different name than "Temp"? How about if someone renames the "Calculations" sheet? Not only will your code break, but you'll have to change those strings everywhere in your code. Maybe you'll get them all. Ma
Code Snippets
Sub DoThing()
With Application
.ScreenUpdating = False
.EnableEvents = False
.StatusBar = False
.Calculation = xlCalculationManual
End With
...
...
Code
...
...
With Application
.ScreenUpdating = True
.EnableEvents = True
.StatusBar = True
.Calculation = xlCalculationAutomatic
End With
End SubIf Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
Else
End IfIf Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
End IfSub DoFind()
Dim i As Long
i = 1
Do While Sheets("Temp").Cells(i, "A").Value <> Empty
Dim BearingArray(6) As String
BearingArray(0) = Sheets("Temp").Cells(i, "A").Value
BearingArray(1) = Sheets("Temp").Cells(i, "B").Value
BearingArray(2) = Sheets("Temp").Cells(i, "C").Value
BearingArray(3) = Sheets("Temp").Cells(i, "D").Value
BearingArray(4) = Sheets("Temp").Cells(i, "E").Value
BearingArray(5) = Sheets("Temp").Cells(i, "F").Value
BearingArray(6) = Sheets("Temp").Cells(i, "G").Value
With Sheets("Calculations")
.Cells(17, "K").Value = BearingArray(0)
.Cells(19, "O").Value = BearingArray(1)
.Cells(20, "O").Value = BearingArray(2)
.Cells(23, "O").Value = BearingArray(3)
.Cells(22, "O").Value = BearingArray(4)
.Cells(26, "O").Value = BearingArray(5)
.Cells(17, "L").Value = BearingArray(6)
End With
i = i + 1
If Sheets("Calculations").Cells(17, "M").Value = "PASS" Then
Exit Do
End If
Loop
If Sheets("Temp").Cells(i, "A").Value = Empty Then
MsgBox "No available bearing."
End If
End SubBearingArray(0) = Sheets("Temp").Cells(i, "A").Value
BearingArray(1) = Sheets("Temp").Cells(i, "B").Value
BearingArray(2) = Sheets("Temp").Cells(i, "C").Value
BearingArray(3) = Sheets("Temp").Cells(i, "D").Value
BearingArray(4) = Sheets("Temp").Cells(i, "E").Value
BearingArray(5) = Sheets("Temp").Cells(i, "F").Value
BearingArray(6) = Sheets("Temp").Cells(i, "G").ValueContext
StackExchange Code Review Q#135182, answer score: 6
Revisions (0)
No revisions yet.