Vlookup faster using VBA Dictionary

[Matrixx2525]

Hello,

I'm trying to learn the Dictionary to speed up my Vlookup but it won't work.

My case is very simple: I have Sheet 1 with names+ages and need to add the profession, found in Sheet 2:

Sheet1
=====
Name|Age|Profession
John|25|
Marc|31|
Susan|54|
Karin|21|

Sheet2
=====
Name|profession
Karin|doctor
John|teacher
Karin|unemployed
Marc|shoe salesman

Normally, I would use the simple Vlookup as a formula or in VBA, but I use 100.000+ records, so this solution is slow...

Can anybody give me some code how to add the profession from Sheet2 into Sheet1-row C using the Scripting Dictionary?

Thanks so much in advance, this would really help me.

best regards,

Jeroen

 

[kevin9999]

My macro

My macro looked up 13,895 values in a table of 7,994 values, returning and storing lookups in an array from 6 different columns. It took 0.533 seconds.

Thank you for getting back to me so quickly. I'm a great believer in Dictionaries - you should see what they can do with Sumifs()! When it comes to VLOOKUP, I've always found the fastest method is to sort the lookup table by the key column & use the TRUE option (we get so used to using the FALSE).
Thanks again

 

[ciaran3]

This is excellent - and I didn't know you could use the dictionary for multiple columns. I just adapted this by storing the lookup values and tables in arrays rather than ranges: this speeds up execution by a factor of about 30 in my tests:

Sub MG06Feb28_WBD()

    Dim dblStart As Double
    Dim oDictionary As Object
    Dim rngIndex As Range
    Dim rngLookupValue As Range
    Dim avarLookupTable As Variant
    Dim avarIndex() As Variant
    Dim avarResults() As Variant
    Dim i As Long
   
    dblStart = Timer
   
    Application.ScreenUpdating = False
   
    With Sheets("Lookup in This Table")
        avarLookupTable = .Range("A1").CurrentRegion.Resize(, 10)
    End With
   
    Set oDictionary = CreateObject("Scripting.Dictionary")
    oDictionary.CompareMode = vbTextCompare
   
    For i = 2 To UBound(avarLookupTable, 1)
        oDictionary(avarLookupTable(i, 1)) = i
    Next
   
    With Sheets("Table to Complete")
        avarIndex = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Value
   
        ReDim avarResults(UBound(avarIndex()), 2)
       
        For i = 1 To UBound(avarResults)
            If oDictionary.Exists(avarIndex(i, 1)) Then
                avarResults(i, 1) = avarLookupTable(oDictionary(avarIndex(i, 1)), 5)
                avarResults(i, 2) = avarLookupTable(oDictionary(avarIndex(i, 1)), 6)
            End If
        Next
   
        .[c2:d2].Resize(UBound(avarResults)).Value = avarResults
   
    End With
   
    Application.ScreenUpdating = True
   
    Debug.Print "That took " & (Timer - dblStart) & " seconds"
   
End Sub

I'm probably doing something obtuse, but using this and trying to right the final results to column D (have data in columns A-C)... how do I get that last piece to work without overwriting what's in column C already?

 

[ciaran3]

To add - I'm only bringing in 1 column

 

[Fv4658]

To add - I'm only bringing in 1 column

Did you figure this out? I tried the code in the above thread but I get blank a blank column to the left of the data and a blank row above. This deletes data I need in the workbook