VBA: Use Dictionary instead vlookup function - excel

Question

I'm using the vlookup function in my vba code, but it's taking too much time to run when I have more then 100k rows of data:
Sub getType()
Application.ScreenUpdating = False
Application.Calculation = xlManual
On Error Resume Next
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim Row As Long
Dim Clm As Long
Set ws = Sheets("P")
LastRow1 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Table1 = Sheet2.Range("A2:A" & LastRow1)
Set ws = Sheets("CRI")
LastRow2 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Table2 = CRI.Range("A2:D" & LastRow2)
Row = Sheet2.Range("J2").Row
Clm = Sheet2.Range("J2").Column
For Each cl In Table1
Sheet2.Cells(Row, Clm).Value = Application.WorksheetFunction.VLookup(cl, Table2, 4, False)
Row = Row + 1
Next cl
Calculate
Reading some topics here I checked that it's possible to speed up by using dictionary, but I didn't understand the concepts correctly to implement the solution on my code.
Also, there is no duplicate data on table2, but table1 contains duplicate values.
Could anyone please help me convert vlookup to dictionary and if possible reference some videos tutorials so I can learn the concept?

Answer 1

This is good explanation on the use of a dictionary:
https://excelmacromastery.com/vba-dictionary/
Don't forget to add “Microsoft Scripting Runtime” as a reference to your project.
I ran a few tests to check performance. For a million rows of data I had the following results:
VLookup: 27.93 seconds
Dictionary: 20.83 seconds
Dictionary and array: 2.32 seconds
Have you considered using a dictionary and an array to store the values before writing them to the sheet? This link will provide you with some good information:
https://excelmacromastery.com/excel-vba-array/#How_To_Make_Your_Macros_Run_at_Super_Speed
Consider the following (I tried to leave as much of your original code as possible):
Application.ScreenUpdating = False
Application.Calculation = xlManual
On Error GoTo Handler
Dim ws As Worksheet
Dim LastRow1 As Long
Dim LastRow2 As Long
Dim i As Long
Dim Table1 As Range
Dim Table2 As Range
Dim cl As Range
Dim r As Range
Dim targetRange As Range
Dim valuesArray As Variant
Dim dict As New Scripting.Dictionary
Dim timeStart As Double
Dim timeInterval As Double
'start a timer to measure performance
timeStart = Timer()
'Get the column of data to search through
Set ws = Sheets("P")
LastRow1 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set Table1 = ws.Range("A2:A" & LastRow1)
'Get the table of values to search for
Set ws = Sheets("CRI")
LastRow2 = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set Table2 = ws.Range("A2:D" & LastRow2)
'Add the contents of the table you are searching to the dictionary:
'For each row in the table
For Each r In Table2.Rows
'Add the key and associated value for that key
dict.Add r.Cells(1, 1).Value, r.Cells(1, 4).Value
Next r
'Dimension an array to fit all of your values
ReDim valuesArray(1 To LastRow1, 1 To 1)
'Use i to allocate the data to the array
i = 1
For Each cl In Table1
'Set the value of the array element to the value returned by the dictionary
valuesArray(i, 1) = dict(cl.Value)
i = i + 1
Next cl
'Set a target range to put your values in and make it the right size to fit your array
Set targetRange = Worksheets("Target").Range("J2").Resize(UBound(valuesArray, 1) - 1)
'Put the array in the target range
targetRange = valuesArray
'Check how much time it took
timeInterval = Timer() - timeStart
Debug.Print timeInterval
Application.ScreenUpdating = True
Hope this helps.

Answer 2

Here's some test code to show why I suggested running your VLOOKUP against the range on the worksheet instead of against the array (which is what you got by not using Set Table = ... )
Worksheet formulas like vlookup are optimised for worksheets, not for arrays.
The lookup against the sheet is about 130x faster than the array lookup.
Sub Tester()
Const NUMR As Long = 100000
Dim r As Long, arr, t, m, rng
'Fill some dummy data if not already there
If Sheet1.Range("A1") = "" Then
For r = 1 To NUMR
Sheet1.Cells(r, 1).Resize(1, 4).Value = _
Array(CLng(Rnd * NUMR), "A", "B", r)
Next r
End If
Set rng = Sheet1.Range("A1").CurrentRegion
arr = rng.Value
'Vlookup against array
t = Timer
For r = 1 To 100
m = Application.VLookup(r, arr, 4, False)
Next r
Debug.Print Timer - t '>> 10.28
'Vlookup against worksheet Range
t = Timer
For r = 1 To 100
m = Application.VLookup(r, rng, 4, False)
Next r
Debug.Print Timer - t '>> 0.078
End Sub