HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Audit Updating Macro

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
auditupdatingmacro

Problem

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

Solution

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

Code Snippets

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Public Sub DoThing()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual


    ...


    Code


    ...


    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub
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
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
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

Context

StackExchange Code Review Q#133205, answer score: 6

Revisions (0)

No revisions yet.