# Audit Updating Macro

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

• 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! – Mathieu Guindon Jun 27 '16 at 16:54
• Regarding screen would be buzzing, add application.screenupdating=false at the beginning. – findwindow Jun 27 '16 at 20:46

## 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.

(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.

• Somebody looks like they're after some golden tag badge! Another awesome answer! – Mathieu Guindon Jun 28 '16 at 15:48