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
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 Sub
Each 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 If
It'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 If
I 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 Sub
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.
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. Workbook
s, Worksheet
s, ListObject
s, Range
s 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").Value
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. Maybe you won't. Chances are, it will introduce new errors.
Instead, make some Worksheet
objects and use those:
Sub NewTest()
Dim tempSheet As Worksheet
Set tempSheet = ThisWorkbook.Sheets.Add
Dim calculationSheet As Worksheet
Set calculationSheet = ThisWorkbook.Sheets("Calculations")
PasteBearingDataToTempSheet tempSheet, calculationSheet
FindBearing tempSheet, calculationSheet
End Sub
Sub PasteBearingDataToTempSheet(ByRef tempSheet As Worksheet, ByRef calculationSheet As Worksheet)
calculationSheet.Activate
Dim NewTable As ListObject
Set NewTable = calculationSheet.ListObjects("Full_Bearings_List")
NewTable.Range.SpecialCells(xlCellTypeVisible).Select
NewTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
tempSheet.Range("A1").PasteSpecial xlPasteAll
Application.CutCopyMode = False
'This sub copies all visible cells from a filtered table and pastes them to the new sheet called "Temp"
End Sub
Sub FindBearing(ByRef dataSheet As Worksheet, ByRef calculationSheet As Worksheet)
Dim i As Long
i = 1
Do While dataSheet.Cells(i, "A").Value <> Empty
Dim BearingArray(6) As String
With dataSheet
BearingArray(0) = .Cells(i, "A").Value
BearingArray(1) = .Cells(i, "B").Value
BearingArray(2) = .Cells(i, "C").Value
BearingArray(3) = .Cells(i, "D").Value
BearingArray(4) = .Cells(i, "E").Value
BearingArray(5) = .Cells(i, "F").Value
BearingArray(6) = .Cells(i, "G").Value
End With
With calculationSheet
.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 calculationSheet.Cells(17, "M").Value = "PASS" Then
Exit Do
End If
Loop
If dataSheet.Cells(i, "A").Value = Empty Then
MsgBox "No available bearing."
End If
End Sub
Now, if either of those names change, you only have to change the declaration in one place, and the rest of your code will continue running perfectly. Notice how we don't even have to name the tempSheet
. We just create it directly into a worksheet
object.
And how about this:
If calculationSheet.Cells(17, "M").Value = "PASS" Then
Exit Do
End If
What is the significance of the particular cell? How do we know what it's supposed to be? And how do we check that it is what it's supposed to be?
Depending on your workbook, my first suggestion would be to make that cell a Named Range.
If we named that cell "ValidateBearing"
then we could do the following:
Dim validationCell As Range
Set validationCell = ThisWorkbook.Names("ValidateBearing").RefersToRange
Const VALIDATION_PASS_TEXT As String = "PASS"
Do While dataSheet.Cells(i, "A").Value <> Empty
...
...
If validationCell.Text = VALIDATION_PASS_TEXT Then
Exit Do
End If
And now, not only have we made it clear what that cell is and what it's doing, but that cell can now move around as much as it likes. As long as nobody actually deletes the row/column/sheet it's in, that code will always point to the right place.
Other tips & Tricks
Do While dataSheet.Cells(i, "A").Value <> Empty
should be
Do While Not IsEmpty(dataSheet.Cells(i, 1))
If dataSheet.Cells(i, "A").Value = Empty Then
MsgBox "No available bearing."
End If
This is hacky. Add a proper Boolean
variable to check for conditions:
Dim foundBearing As Boolean
foundBearing = False
Do While Not IsEmpty(dataSheet.Cells(i, 1))
...
...
If validationCell.Text = VALIDATION_PASS_TEXT Then
foundBearing = True
Exit Do
End If
Loop
If Not foundBearing Then
MsgBox "No available bearing."
End If
You can drop .Select
everywhere and always.
A.B.Select
Selection.DoThing
Is always the same as just doing
A.B.DoThing
Here:
NewTable.Range.SpecialCells(xlCellTypeVisible).Select
NewTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
You can drop the first line entirely and it will still run perfectly fine.
Get used to using Sheet.Cells(row, column)
instead of Sheet.Range("[Address]")
. Not only is it faster, but it's semantically closer to what cells actually are, and you can't do things like this anywhere near as easily with addresses:
Dim startRow As Long
startRow = 1
Dim finalRow As Long
finalRow = [Get final Row]
Dim startColumn As Long
startColumn = 1
Dim finalColumn As Long
finalColumn = [Get final Column]
Dim iRow As Long
Dim iColumn As Long
For iRow = startRow To finalRow
For iColumn = startColumn To finalColumn
With [Sheet].Cells(iRow, iColumn)
[Do Stuff]
End With
Next iColumn
Next iRow