7
\$\begingroup\$

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

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.

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.