Option Explicit
That should be at the top of every VBA module you ever create. Go to Tools -> Options -> Require Variable Declaration to have it inserted automatically. It's important because it forces you to declare every variable you use, and so automatically gets you to declare types and catches any typos that creep in. Those 2 alone will prevent all sorts of problems down the line.
Very Low Hanging Performance Fruit
VBA has 3 of these:
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Doing the following will vastly increase the speed of your code:
Public Sub DoThing()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
...
Code
...
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
In this case, since you're relying on certain formulas to throw errors, you should probably keep Application.Calculation
on xlCalculationAutomatic
.
Use the Object Model
The great power of VBA comes from its' tight integration with the Office Object Model (from were Intellisense gains its' power).
Worksheet
objects, Workbook
objects, Range
objects, Array
objects, Err
(error) objects etc.
Rather than constantly activating different worksheets, put them in objects and then refer to them instead:
Dim sourceDataSheet As Worksheet
Set sourceDataSheet = Worksheets(1)
Dim foundItemsSheet As Worksheet
Set foundItemsSheet = Worksheets(2)
Dim remainingItemsSheet As Worksheet
Set remainingItemsSheet = Worksheets(3)
...
Do While sourceDataSheet.Cells(k, 24) <> ""
Tab_Data = sourceDataSheet.Range(sourceDataSheet.Cells(k, 24), sourceDataSheet.Cells(k, 44)).Value
remainingItemsSheet.Range(remainingItemsSheet.Cells(k, 1), remainingItemsSheet.Cells(k, 21)).Value = Tab_Data
k = k + 1
Loop
This also lets you do really awesome things like hold object references using With
statements:
Do While sourceDataSheet.Cells(k, 24) <> ""
With sourceDataSheet
Tab_Data = .Range(.Cells(k, 24), .Cells(k, 44)).Value
End With
With remainingItemsSheet
.Range(.Cells(k, 1), .Cells(k, 21)).Value = Tab_Data
End With
k = k + 1
Loop
And now you can forget about having to keep using Activate
ever again.
It also lets you re-use references, so this:
Do While Cells(i, 1).Value <> "" And Not IsError(Cells(i, 2).Value)
Dataset = Range(Cells(i, 1), Cells(i, 22)).Value
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(2).Activate
Range(Cells(i, 1), Cells(i, 22)).Value = Dataset
Worksheets(1).Activate
For j = 2 To Aud_Tot
If CStr(Cells(j, 24).Value) = CStr(Cells(i, 2).Value) Then
Worksheets(3).Activate
Range(Cells(j, 1), (Cells(j, 22))).Delete Shift:=xlShiftUp
Worksheets(1).Activate
Exit For
End If
Next j
i = i + 1
Loop
becomes this:
Dim startCell As Range
Dim errCheckCell As Range
Const START_COLUMN As Long = 1
Const ERR_CHECK_COLUMN As Long = 2
Const END_COLUMN As Long = 22
Dim sourceDataRange As Range
Dim pasteDataRange As Range
Set startCell = sourceDataSheet.Cells(i, START_COLUMN)
Set errCheckCell = sourceDataSheet.Cells(i, ERR_CHECK_COLUMN)
Do While startCell.Value <> "" And Not IsError(errCheckCell.Value)
With sourceDataSheet
Set sourceDataRange = .Range(.Cells(i, START_COLUMN), .Cells(i, END_COLUMN))
End With
With foundItemsSheet
Set pasteDataRange = .Range(.Cells(i, START_COLUMN), .Cells(i, END_COLUMN))
End With
Dataset = sourceDataRange
sourceDataRange = Dataset
pasteDataRange = Dataset
For j = 2 To Aud_Tot
If CStr(sourceDataSheet.Cells(j, 24).Value) = CStr(errCheckCell.Value) Then
With remainingItemsSheet
.Range(.Cells(j, 1), (.Cells(j, 22))).Delete Shift:=xlShiftUp
End With
Exit For
End If
Next j
i = i + 1
Loop
which looks a little bigger (right now, we'll get to cleaning it up later) but is much, much clearer about what's going on and where, and lets you change just one reference if and when things get moved/changed in the future.
For instance, what happens if your order of worksheets gets changed? Now, you only have to change that once, right at the start, and the rest takes care of itself.
Tips and Tricks
finalRow
- Want to find the last used row in a column?
Dim finalRow As Long
With sheetObject
finalRow = .Cells(.Rows.Count, targetColumn).End(xlUp).Row
End With
And you can then use
For k = 2 To finalRow
...
Next k
instead of that unwieldy Do While cellReference(k).Value <> ""
constants
- if you're going to hard-code values (e.g. Column 1, Column 22, Worksheets(1)
) then actually hard-code them. Once. In one place. So you can change it in a single go rather than having to track down every occurence of the thing (and invariably missing some and causing errors).
The proper variable for a constant value is, unsurprisingly a Constant
. Standard VBA Naming Conventions use SHOUTY_SNAKE_CASE
for constants. Created like so:
Option Explicit
Public Const GLOBAL_CONSTANT As Boolean = True
Private Const MODULE_CONSTANT As Long = 42
Public Sub DoThing()
Const PROCEDURE_CONSTANT As Long = 1
...
End Sub
Codenames - Every Worksheet
has a codename (name)
property. If you got to the properties window in the Editor, select a worksheet and type, e.g. sheetCodename
in the (name)
property, then you can write a procedure like so:
Public Sub DoThingWithSheet()
sheetCodename.Cells(1, 1).Value = 1
without having to declare the sheet, or assume anything about its' name, or its' position in your workbook, or anything else. The variable is just there, constant and unchanging.
Your Code, Better
(assuming we've already given your sheets the following codenames: dataSheet
, foundItemsSheet
, remainingItemsSheet
)
Public Sub UpdateAudit()
Const TAB_START_COLUMN As Long = 24
Const TAB_END_COLUMN As Long = 44
Const TAB_PASTE_START_COLUMN As Long = 1
Const TAB_PASTE_END_COLUMN As Long = 1
Const START_ROW As Long = 2 '/ +1 for headers
Dim numItemsToAudit As Long
numItemsToAudit = Application.InputBox("How big is your audit", Type:=1)
Dim finalRow As Long
With dataSheet
finalRow = .Cells(.Rows.Count, TAB_START_COLUMN).End(xlUp).Row
End With
'/ Copy All Raw Data to "remainingItemsToFind" sheet
Dim tabData As Variant
Dim iRow As Long
For iRow = START_ROW To finalRow
With dataSheet
tabData = .Range(.Cells(iRow, TAB_START_COLUMN), Cells(iRow, TAB_END_COLUMN))
End With
With remainingItemsSheet
.Range(.Cells(iRow, TAB_PASTE_START_COLUMN), .Cells(iRow, TAB_PASTE_END_COLUMN)) = tabData
End With
Next iRow
'/ For each row in "rawData" sheet, check for error.
'/ If not error, copy to "foundItems" sheet and delete from "remainingItems" sheet
Const FOUND_START_COLUMN As Long = 1
Const FOUND_END_COLUMN As Long = 22
Const FOUND_ERR_CHECK_COLUMN As Long = 2
Const REMAINING_ERR_CHECK_COLUMN As Long = 24
With dataSheet
finalRow = .Cells(.Rows.Count, FOUND_START_COLUMN).End(xlUp).Row
End With
Dim dataArray As Variant
Dim dataRange As Range
Dim pasteRange As Range
Dim foundErrCheckCell As Range
Dim remainingErrCheckCell As Range
Dim errCheckRow As Long
For iRow = START_ROW To finalRow
Set foundErrCheckCell = dataSheet.Cells(iRow, FOUND_ERR_CHECK_COLUMN)
If Not IsError(foundErrCheckCell) Then
'/ Get Source Data
With dataSheet
Set dataRange = .Range(.Cells(iRow, FOUND_START_COLUMN), .Cells(iRow, FOUND_END_COLUMN))
End With
dataArray = dataRange
With foundItemsSheet
Set pasteRange = .Range(.Cells(iRow, FOUND_START_COLUMN), .Cells(iRow, FOUND_END_COLUMN))
End With
'/ Copy Data
dataRange = dataArray
pasteRange = dataArray
'/ Find and Delete from "remainging items" sheet
For errCheckRow = 2 To numItemsToAudit
Set remainingErrCheckCell = dataSheet.Cells(errCheckRow, REMAINING_ERR_CHECK_COLUMN)
If remainingErrCheckCell.Text = foundErrCheckCell.Text Then
remainingItemsSheet.Rows(errCheckRow).Delete shift:=xlShiftUp
Exit For
End If
Next errCheckRow
Next iRow
End Sub
You'll notice the better code looks longer. This is entirely down to having more variable declarations and adding some whitespace for readability. When measuring code, the metric that matters is not how much you can cram into a small space, but how quickly you can read and understand the code and how to change it.
End Sub
statement inside of it - code blocks ought to be indented with 4 leading spaces. If this edited code doesn't look exactly as it does in your IDE, please feel free to edit further to make it so. I hope you get good reviews! \$\endgroup\$screen would be buzzing
, addapplication.screenupdating=false
at the beginning. \$\endgroup\$