Is there a faster way to cycle through my list?

Question

I have a list that is copied from one worksheet into a "calculation" sheet, and a second list that is copied from another worksheet into the same "calculation" sheet. Before my macro, I used a =VLOOKUP() formula to determine if each item had a match in the other list, and visa versa. Right now my code cycles item by item.

Is there a more efficient/time saving way to get the same outcome? (I have a copy of this sub for the counter comparison -- this is A > B, other is B > A)

Here's the code:

Sub GPWireDifference()

'Establishes the Unmatched Great Plains Values list
    Set BWGPValues = New Dictionary


'Creates a variable to check if Keys already exist in list
    Dim lookup As String
    'Creates a variable to store the unmatched amount
    Dim amount As Currency
    'Sets a variable to count the amount of items in the checked list
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


'Format all columns in the Calculation sheet to fit their contents
    Cells.EntireColumn.AutoFit
    'Formatting the numbers to the common "currency" type
    Range("B:E").NumberFormat = "$#,##0.00"
    Range("D2").Activate


'In the event of the value not matching, send the chain to a separate segment
    On Error GoTo ErrorHandler:


'Creates a loop to set the cell values to the results of the VLookup formula
    Do Until ActiveCell.Offset(0, -3).Value = ""
        ActiveCell.Value = Application.WorksheetFunction. _
            IfError(Application.WorksheetFunction. _
                VLookup(ActiveCell.Offset(0, -2), Range("C:C"), 1, False), 0)
        ActiveCell.Offset(1, 0).Activate
    Loop


'This error handler is to create a buffer so the macro doesn't lock itself into the
' error status... Unsure why, but if the buffer wasn't here, it breaks the code
ErrorHandler:
    If Not ActiveCell.Offset(0, -3).Value = "" Then
        GoTo ErrorHandler2:
    End If


'This error handler sets the Key and Item for the list, and stores the values
ErrorHandler2:
    If Not ActiveCell.Offset(0, -3).Value = "" Then
        lookup = ActiveCell.Offset(0, -3).Value
        amount = ActiveCell.Offset(0, -2).Value
        'Checks to see if the Key already exists. If so, sets the item value to the
        ' sum of the existing value and the new value
        If BWGPValues.Exists(lookup) Then
            BWGPValues(lookup) = BWGPValues(lookup) + amount
        Else 'If not, then it adds the key and the item values
            BWGPValues.Add lookup, amount
        End If
        Resume Next 'Returns to the loop
    End If


'Creates headers for the comparison rows
    Range("D1").Value = "GP to Wires:"
    Range("E1").Value = "Wires to GP:"


'Reformats the columns to fit all contents
    Cells.EntireColumn.AutoFit

End Sub

Yes. read up on [why you should avoid activate/select methods](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). You may further see improvement gains by dumping the data in to arrays or dictionaries and processing those, rather than the worksheet/cells. — David Zemens, Jul 19 '16 at 17:35
@DavidZemens Well, it seems by doing this, I only change `ActiveCell.Offset(1,0).Activate` to `[Range] = [Range].Offset(1,0)`. This keeps the same issue of going line-by-line — Munkeeface, Jul 19 '16 at 17:39
Assuming code **works** this is better suited for [Code Review](http://codereview.stackexchange.com) — Scott Holtzman, Jul 19 '16 at 17:40
Not to mention you auto fit stuff should probably be done all at once at the tail end. — Doug Coats, Jul 19 '16 at 17:40
I've never seen the need for a double-error handler, either. Something else is wrong, but it's difficult to say what that might be. — David Zemens, Jul 19 '16 at 17:40
you could also turn off/on Calculations, Screen Updating and Display Alerts — Doug Coats, Jul 19 '16 at 17:42
Yes, you'll still need to do line-by-line or item-by-item. I would look in to using the `Application.Vlookup` function rather than the similar function from `WorksheetFunction` class. The reason being that the `Application.Vlookup` doesn't raise an error, it's capable of *returning* an error type, so you don't need additional handlers to deal with "match not found", you just use the VBA `IsError` function to check that. — David Zemens, Jul 19 '16 at 17:44
I would follow @ScottHoltzman's advice and move this to [Code Review](http://codereview.stackexchange.com/). — Victor Moraes, Jul 19 '16 at 17:46
I don't think I agree with moving this to Code Review. Yea, you can review the code provided by the OP, but that's not what the OP is asking. It's asking a specific question: is there a faster and less computationally expensive way to compare the contents of two lists? The answer is yes, there are many ways to do that better. — u8it, Jul 19 '16 at 18:07
@DavidZemens The reason for the double-error handler is because when it threw the first error, the exception was handled correctly, but on the second error, it would read that the status of the error was still satisfied and break the code. It was a while ago when I finished this section of the macro, but I do recall it being a safe workaround — Munkeeface, Jul 19 '16 at 20:19

score 3 · Answer 1 · answered Jul 19 '16 at 17:46

3

This:

Do Until ActiveCell.Offset(0, -3).Value = ""
    ActiveCell.Value = Application.WorksheetFunction. _
        IfError(Application.WorksheetFunction. _
            VLookup(ActiveCell.Offset(0, -2), Range("C:C"), 1, False), 0)
    ActiveCell.Offset(1, 0).Activate
Loop

would be better as:

Dim c As Range, res
Set c = Range("D2")

Do Until c.Offset(0, -3).Value = ""
    res = Application.VLookup(c.Offset(0, -2), Range("C:C"), 1, False)
    'if no match then res will contain an error, so test for that...
    c.Value = IIf(IsError(res), 0, res)

    Set c = c.Offset(1, 0)
Loop

Removing the select/activate is faster, and dropping the WorksheetFunction prevents the triggering of a run-time error if the Vlookup doesn't get a match

answered Jul 19 '16 at 17:46

Tim Williams

154,628
8
97
125

I will try out the active -> range switch, but if I remove the WorksheetFunction line, how will I still have an output in the sheet to visually mark which value did not have a match? Currently the blank cells (where the error was thrown) in the column beside the data columns are an identifier. The purpose of keeping all data would be for any possible audit purposes, whether formal through an external firm or internally informal. – Munkeeface Jul 19 '16 at 20:22
1

Using `WorksheetFunction` doesn't directly create any output - you still have to do something with the return value: the main difference on dropping it is you don't get run-time errors when there's no match, so you can structure your code a bit more easily. I didn't try to follow what you were doing in that double error handler, but you wouldn't need any of that if you don't use `WorksheetFunction` – Tim Williams Jul 19 '16 at 21:24

score 0 · Answer 2 · answered Jul 19 '16 at 19:23

I tested with lists of 3000 values. Not sure if you're using it already but Application.ScreenUpdating = False should definitely be used (difference is 2500 ms to 220 ms for my test case). Aside from that, you can further optimize using something like the code below, which executes both comparisons in about 20 ms, saving you about 420 ms or almost 1/2 a second.

Sub GPWireDifference()

'Prevent screen updating during execution
Application.ScreenUpdating = False

'Establishes the Unmatched Great Plains Values list
    Set BWGPValues = New Dictionary


'Creates a variable to check if Keys already exist in list
    Dim lookup As String
    'Creates a variable to store the unmatched amount
    Dim amount As Currency
    'Sets a variable to count the amount of items in the checked list
    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row


'Format all columns in the Calculation sheet to fit their contents
    Cells.EntireColumn.AutoFit
    'Formatting the numbers to the common "currency" type
    Range("B:E").NumberFormat = "$#,##0.00"
    Range("D2").Activate

    'Place entire range in memory as array
    Dim A() As Variant: A = Range("B2:B" & lastRow).Value2
    'Create Dictionary to contain all unqiue values from list
    'The dictionary will store a collection of indexes for that unique value
    Dim Au As New Dictionary
    For i = 1 To UBound(A)
        If Not Au.Exists(A(i, 1)) Then
            Au.Add A(i, 1), New Collection
        End If
        Au(A(i, 1)).Add i
        A(i, 1) = ""
    Next

    'Repeat above steps for list B
    Dim B() As Variant: B = Range("C2:C" & lastRow).Value2
    Dim Bu As New Dictionary
    For i = 1 To UBound(B)
        If Not Bu.Exists(B(i, 1)) Then
            Bu.Add B(i, 1), New Collection
        End If
        Bu(B(i, 1)).Add i
        B(i, 1) = ""
    Next

    'Loop through unique values in A
    'If found in B's unique value list then populate B indexes with value
    For Each k In Au
        If Bu.Exists(k) Then
            For Each i In Bu(k)
                B(i, 1) = k
            Next
        End If
    Next

    'Loop through unique values in B
    'If found in A's unique value list then populate A indexes with value
    For Each k In Bu
        If Au.Exists(k) Then
            For Each i In Au(k)
                A(i, 1) = k
            Next
        End If
    Next

    'Assign Array back to Range
    Range("D2:D3000") = A
    Range("E2:E3000") = B

'Creates headers for the comparison rows
    Range("D1").Value = "GP to Wires:"
    Range("E1").Value = "Wires to GP:"


'Reformats the columns to fit all contents
    Cells.EntireColumn.AutoFit

End Sub

Yes, `Application.ScreenUpdating = False` is the first line in the entire macro, which then calls several subs. This is just one of the subs. All-in-all the macro is roughly 2300 lines long (save for the blank lines for documentation and formatting code). Overall the code takes roughly 8-10 seconds if the input data is 100/100 values deep (both lists). This process is run three times overall (at different steps in the code). If run in this method, how much time would you say would be saved? — Munkeeface, Jul 19 '16 at 20:27
@Munkeeface Well it should be set to go, so you can just copy and paste to test it on your system. I'm sure you've got other equations and factors that affect your total time but the code above should execute nearly instantaneously for two lists 100 long. If you have a lot of equations on your sheet the recalculation may be part of what's killing your time. This code should help with that too. — u8it, Jul 19 '16 at 20:57

Is there a faster way to cycle through my list?

2 Answers2