1
\$\begingroup\$

I have a worksheet that contains values, and I need to match one of the values to a lookup worksheet. This syntax works like it should, however, it takes roughly 10 minutes to fully execute. This could be due to the size of the worksheets: Sheet1 has roughly 18,000 rows and Sheet2 has roughly 20,000 rows.

Is there any optimization that can take place in this syntax?

Function TwoMatches()
Dim wSheet As Worksheet: Set wSheet = Sheets("Sheet2")
Dim lookupSheet As Worksheet: Set lookupSheet = Sheets("Sheet1")
Dim lr As Long: lr = wSheet.Cells(wSheet.Rows.Count, "A").End(xlUp).Row
Dim destSheet As Worksheet: Set destSheet = Sheets("Sheet2")
Set lookupRange = Sheets("Sheet1").Range("$A:$C")
Dim Found As Range

'Add a column at the beginning to Trim() and Remove Hyphens
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

'Add Clean Sheet1 Name As Header Text
ActiveWorkbook.Sheets("Sheet2").Range("A1").Value = "Clean Sheet1 Name"

'This is the worksheet formula that I want to use for the used range
With wSheet
    lr = .Cells(.Rows.Count, "D").End(xlUp).Row
    form = "=TRIM(SUBSTITUTE(D2,""-"", """"))"
    .Range("A2:A" & lr).Formula = form
End With

'Get the Last Column With Data
ActiveWorkbook.Sheets("Sheet2").Range("P1").Value = "LookupVal"

For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
    'Pulling value where column O is not null
    If Not IsEmpty(Cells(i, "O").Value) Then
    With Sheets("Sheet1")
        'Filter criteria one is where column B IS NOT NULL
        .Range("$A:$C").AutoFilter Field:=2, Criteria1:="<>"

        Set Found = .Range("A:A").Find(What:=wSheet.Cells(i, "A").Value, _
                               LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                               MatchCase:=False)

        If Not Found Is Nothing Then
            wSheet.Cells(i, "P").Value = Found.Offset(, 2).Value
        End If
    End With
    'Pulling value where column O is null
    Else
    With Sheets("Sheet1")
        'Filter criteria one is where column B IS NULL
        .Range("$A:$C").AutoFilter Field:=2, Criteria1:="="
        Set Found = .Range("A:A").Find(What:=wSheet.Cells(i, "A").Value, _
                               LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                               MatchCase:=False)

        If Not Found Is Nothing Then
            wSheet.Cells(i, "P").Value = Found.Offset(, 2).Value
        End If
    End With
    End If
Next i
'Removing the column added for the Clean Match
Range("A:A").Delete
End Function
\$\endgroup\$
  • \$\begingroup\$ Noting that you're using Find in your match function, I started to wonder if it would be faster to pull the Range into a Variant array. Luckily for me (and everyone here), a quick search turned up this well done article. Just FYI... Match is the winner, with the Variant array coming in second but it does depend on the data and your expected results. So this may help. \$\endgroup\$ – PeterT Apr 24 '17 at 14:09
  • \$\begingroup\$ @PeterT -> very interesting read, thanks for providing! \$\endgroup\$ – user2676140 Apr 24 '17 at 14:45
  • \$\begingroup\$ @user2676140 I would definitely recommend looking into some kind of Variant array matching here. The solution I generally use is to store my values within a dictionary with their unique keys as the keys of the dictionary. I can then just call If Dict.Exists(Value) Then Output = Dict(Value) (in pseudocode of course). Definitely avoid on-worksheet manipulation as much as possible. From what I have seen, there are very few instances where on-sheet manipulation may be faster. \$\endgroup\$ – Brandon Barney Apr 24 '17 at 16:46
3
\$\begingroup\$

General points

  • both wSheet and destSheet points to "Sheet2", I suppose you don't need both
  • while you can save a few lines using :, it's generally considered to be a bad practice to use them.
  • functions are generally more or less portable, hardcoding sheet names in them makes it impossible. You could pass sheet names as arguments
  • lookUpRange is not declared
    • You should always use Option Explicit in your code
  • Dim Found As Range - it's name suggests it's a boolean, not a range
  • lr = wSheet.Cells(wSheet.Rows.Count, "A").End(xlUp).Row - you set the value at the beginning, but never use it, just overwrite
  • ActiveWorkbook.Sheets("Sheet2").Range("P1").Value = "LookupVal" You've declared variables for Sheet2, why don't use them?
  • ... and a lot of other similar issues

General performance

  • you can use these at the beginning of your codeto speed up your code:
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

  • to perform calculations after inserting the formulas use
    Application.calculate

Specific suggestion

.Range("$A:$C").AutoFilter Field:=2, Criteria1:="<>"
Set Found = .Range("A:A").Find(What:=wSheet.Cells(i, "A").Value, _
    LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _                                                                 
    MatchCase:=False)
If Not Found Is Nothing Then
    wSheet.Cells(i, "P").Value = Found.Offset(, 2).Value
End If

It's difficult to give the best solution without looking your data, but here I'd definitely use some formula (Index / match / row / ...) instead of filtering the data thousands of times. Or at least sort data to avoid some of the filtering.

\$\endgroup\$
  • \$\begingroup\$ How does 'Found' indicate it is a boolean by name? While it is possible for this assumption to be reached by reading the code, there isn't anything explicitly noting it as a boolean within the naming of the variable. \$\endgroup\$ – Brandon Barney Apr 24 '17 at 16:44
  • \$\begingroup\$ Also worth noting, he has a number of unqualified ranges as well. You can note this within your 'General Points'. \$\endgroup\$ – Brandon Barney Apr 24 '17 at 16:53
  • 1
    \$\begingroup\$ @brandon Found is pretty much always True or False I'd say using target for finding a range is more standard. That being said, 'Found' (as a boolean) isn't particularly useful anyway, maybe IsFound or IsFoundInArray. \$\endgroup\$ – Raystafarian Apr 24 '17 at 17:24
  • \$\begingroup\$ @Raystafarian I was not aware of that. Good to know. Agreed though that target tends to be more standard (and it is the variable name I tend to use as well). I personally would also tend to avoid IsFound or any IsSomething's since these tend to denote a Boolean function return (IsEmpty, IsNothing, etc.). \$\endgroup\$ – Brandon Barney Apr 24 '17 at 17:26
2
\$\begingroup\$

I made some changes to improve your code overall. This wont improve performance, but these changes are worth noting nonetheless:

Sub Test()
Dim MainBook As Workbook

' Find a better way over using ActiveWorkbook since ActiveWorkbook is unpredictable.
Set MainBook = ActiveWorkbook

' Edited this to be more precise
'ActiveWorkbook.Sheets("Sheet2").Range("P1").Value = "LookupVal"


Dim MainSheet As Worksheet
Set MainSheet = MainBook.Sheets("Sheet2")
' Name your worksheets. Never use 'Sheet2'
' Also, why enter 'LookupVal' here? You do realize you are entering the literal 'LookupVal' as a string right?
MainSheet.Range("P1").Value = "LookupVal"

' Declare i
Dim i As Long

'Qualify your range reference
'For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
For i = MainSheet.Range("A" & MainSheet.Rows.Count).End(3).Row To 2 Step -1

    'Pulling value where column O is not null
    ' Again, qualify your references. I just made changes below instead of showing your initial coding.
    If Not IsEmpty(MainSheet.Cells(i, "O").Value) Then
        With MainBook.Sheets("Sheet1")
            'Filter criteria one is where column B IS NOT NULL
            .Range("$A:$C").AutoFilter Field:=2, Criteria1:="<>"

            Set Found = .Range("A:A").Find(What:=wSheet.Cells(i, "A").Value, _
                                   LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False)

            ' What the hell is 'wSheet?' It is neither declared, nor set within the scope of this.
            If Not Found Is Nothing Then
                wSheet.Cells(i, "P").Value = Found.Offset(, 2).Value
            End If
        End With

    ' Pulling value where column O is null
    Else
        With MainBook.Sheets("Sheet1")
            'Filter criteria one is where column B IS NULL
            .Range("$A:$C").AutoFilter Field:=2, Criteria1:="="
            Set Found = .Range("A:A").Find(What:=wSheet.Cells(i, "A").Value, _
                                   LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                   MatchCase:=False)

            If Not Found Is Nothing Then
                wSheet.Cells(i, "P").Value = Found.Offset(, 2).Value
            End If
        End With
    End If
Next i
'Removing the column added for the Clean Match
Range("A:A").Delete
End Sub

First of all: qualify your references! Coding like Sheets("SheetName") can cause major issues since the compiler will infer the parent to be the activeworkbook. This works when the activeworkbook is the intended target, but can have drastic consequences elsewhere. Same goes for references to Cells, Rows, Range, etc.

Also, as noted by Mate, declare your variables. Always have Option Explicit at the top of your module. This prevents you from 'using' a variable that is undeclared. This is specifically helpful in cases where a simple typo could otherwise create an entirely new variable and as a result could have unintended consequences.

Focus on not taking action within the workbook. Matching values by filtering a range can have serious performance issues (as you are noting). In my own work, I use a dictionary and a couple of arrays. I went from literally taking hours to compile data (we are talking ~60k rows of data to possibly search through, and matching against 10 or more data sets) to literally processing this data in minutes with dictionaries and arrays.These are powerful tools. Use them.

Finally, in the future please post all of your code. It seems like you cut off the top of your function which makes it difficult to see if there is part of the picture we are missing.

EDIT: See the Dictionary example below

Sub DictMatching()
    Dim ItemInfo As Variant
    ItemInfo = ThisWorkbook.Sheets("Products").Range("ProductInfo").Value

    Dim ItemInfoHeaders As Scripting.Dictionary
    Set ItemInfoHeaders = New Scripting.Dictionary

    Dim i As Long
    For i = LBound(ItemInfo, 2) To UBound(ItemInfo, 2)
        ' Loop through the headers of the key range for use later
        If Not ItemInfoHeaders.Exists(ItemInfo(LBound(ItemInfo, 1), i)) Then _
            ItemInfoHeaders.Add ItemInfo(LBound(ItemInfo, 1), i), i
    Next

    Dim LookupInfo As Scripting.Dictionary
    Set LookupInfo = New Scripting.Dictionary

    LookupInfo.CompareMode = TextCompare

    Dim j As Long
    For i = LBound(ItemInfo, 1) + 1 To UBound(ItemInfo, 1)
        ReDim TempArray(LBound(ItemInfo, 2) To UBound(ItemInfo, 2))

        ' Create a temporary array to hold the data
        For j = LBound(ItemInfo, 2) To UBound(ItemInfo, 2)
            TempArray(j) = ItemInfo(i, j)
        Next

        ' Add the key, and data to the dictionary
        If Not LookupInfo.Exists(ItemInfo(i, ItemInfoHeaders("ID"))) Then _
            LookupInfo.Add ItemInfo(i, ItemInfoHeaders("ID")), TempArray
    Next

    ' This can easily be done with looping, but I hardcoded it to show exactly what is happening
    Debug.Print vbNewLine
    Debug.Print LookupInfo(1327)(ItemInfoHeaders("ID"))
    Debug.Print LookupInfo(1327)(ItemInfoHeaders("Item_Name"))
    Debug.Print LookupInfo(1327)(ItemInfoHeaders("Price"))
    Debug.Print LookupInfo(1327)(ItemInfoHeaders("Qty."))

    Debug.Print vbNewLine
    Debug.Print LookupInfo(1655)(ItemInfoHeaders("ID"))
    Debug.Print LookupInfo(1655)(ItemInfoHeaders("Item_Name"))
    Debug.Print LookupInfo(1655)(ItemInfoHeaders("Price"))
    Debug.Print LookupInfo(1655)(ItemInfoHeaders("Qty."))

    Debug.Print vbNewLine
    Debug.Print LookupInfo(1126)(ItemInfoHeaders("ID"))
    Debug.Print LookupInfo(1126)(ItemInfoHeaders("Item_Name"))
    Debug.Print LookupInfo(1126)(ItemInfoHeaders("Price"))
    Debug.Print LookupInfo(1126)(ItemInfoHeaders("Qty."))

    Debug.Print vbNewLine
    Debug.Print LookupInfo(1184)(ItemInfoHeaders("ID"))
    Debug.Print LookupInfo(1184)(ItemInfoHeaders("Item_Name"))
    Debug.Print LookupInfo(1184)(ItemInfoHeaders("Price"))
    Debug.Print LookupInfo(1184)(ItemInfoHeaders("Qty."))

    Debug.Print vbNewLine
    Debug.Print LookupInfo(1659)(ItemInfoHeaders("ID"))
    Debug.Print LookupInfo(1659)(ItemInfoHeaders("Item_Name"))
    Debug.Print LookupInfo(1659)(ItemInfoHeaders("Price"))
    Debug.Print LookupInfo(1659)(ItemInfoHeaders("Qty."))

    Debug.Print vbNewLine
    Debug.Print LookupInfo(1754)(ItemInfoHeaders("ID"))
    Debug.Print LookupInfo(1754)(ItemInfoHeaders("Item_Name"))
    Debug.Print LookupInfo(1754)(ItemInfoHeaders("Price"))
    Debug.Print LookupInfo(1754)(ItemInfoHeaders("Qty."))

End Sub

Here's the input table:

enter image description here

I apologize for the very basic example of how this would work. I usually use this on pre-built Excel tables where I am extracting data from, and I use a class for this process to make it a bit easier on my end. These are the principles though.

\$\endgroup\$
  • 1
    \$\begingroup\$ If a Dictionary would work better, maybe you could give an example of a dictionary doing this task? It would make the answer more robust. \$\endgroup\$ – Raystafarian Apr 24 '17 at 17:27
  • \$\begingroup\$ I started typing an example using a dictionary but I couldn't figure out where his key range was in order to load it into the dictionary. Ill draw up an example that just uses a an example and made up key range to show how this would work. \$\endgroup\$ – Brandon Barney Apr 24 '17 at 17:28

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.