Audit Updating Macro

Question

In my code, I'm trying to manipulate data for an audit between 3 sheets in a workbook.The first block of my code is to paste the data of items I need to find for the audit from the original sheet onto the 3rd sheet by setting each row equal to the data of the original row in the first sheet. The second block is used to re-paste the data of found objects in the Audit to only have values rather then formulas.Then the code will iterate through the Audit list to check for the same values and delete those values on the list in the 3rd sheet. The 2nd sheet will have the list of found audit items being pasted in at the same time. The end result is 3 sheets, 1st being just the main list where all the data is collected, the 2nd being a list of found audit items, and the 3rd being left over items that need to be found at a later date. The code works and has a few kinks in it where the screen would be buzzing because of all of the activate lines so I was wondering if there were better ways to manipulate data between different sheets in a workbook.

Sub Update_Audit()
 Dim j As Integer
 Dim i As Integer
 Dim k As Integer
 Dim Aud_Tot As Integer
 i = 2
 Aud_Tot = Application.InputBox("How big is your audit", , , , , , , 1)
 k = 2
 Worksheets(1).Activate
 Do While Cells(k, 24) <> ""
 Tab_Data = Range(Cells(k, 24), Cells(k, 44)).Value
 Worksheets(3).Activate
 Range(Cells(k, 1), Cells(k, 21)).Value = Tab_Data
 Worksheets(1).Activate
 k = k + 1
 Loop
 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
End Sub

• Mathieu Guindon: Welcome to Code Review! I've fixed the indentation of the code block so as to include the final 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!
• findwindow: Regarding screen would be buzzing, add application.screenupdating=false at the beginning.

Answer 1

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.

• Mathieu Guindon: Somebody looks like they're after some golden tag badge! Another awesome answer!