Fastest VLOOKUP in worksheet data performed in VBA

Question

I am looking for the quickest way to look up the value in worksheet data and give the corresponding value in another column. The lookup must be done in VBA. Only 1 lookup is

Answer 1

I have tested several different functions in contexts of sorted and unsorted data, 100k and 1 million rows of data.

The fastest way is to use WorksheetFunction.Vlookup or a combination of WorksheetFunction.Index and WorksheetFunction.Match. But in case 2 or more searches are to be done on the same column, then it's best to load data into array (which takes relatively more time) and loop through it (looping through a loaded array is extremely quick).

The summary results of performance tests (having both, 100 000 and 1 million rows of data)

                | 100k rows   | 1m rows     |
---------------------------------------------
 Sub            | sort | uns  | sort | uns  |
---------------------------------------------
 WsF_vlookup    | 0.05 | 0.05 | 0.25 | 0.38 |
 WsF_idx_match  | 0.05 | 0.05 | 0.25 | 0.38 |
 loop_in_array  | 0.06 | 0.06 | 0.35 | 0.43 | - this is better for 2+ lookups
 range_find     | 0.10 | 0.12 | 0.80 | 0.95 |
 match_in_array | 0.11 | 0.11 | 0.65 | 0.80 |
 loop_in_sheet  | 0.14 | 0.16 | 1.2  | 1.39 |
 array_to_dict  | 0.5  | 0.65 | 61   | 87   |
 sheet_to_dict  | 1.5  | 1.70 | 75   | 100  |
---------------------------------------------

Used subroutines

Sub WsF_vlookup()
  Dim timer0 As Single

  timer0 = Timer()
  Debug.Print Application.WorksheetFunction.VLookup("key990000", ThisWorkbook.Worksheets("Sheet1").Range("A1:B1000000"), 2, 0)
  Debug.Print Timer - timer0

End Sub

---

Sub WsF_idx_match()
  Dim timer0 As Single
  Dim rw As Long

  timer0 = Timer()
  rw = Application.WorksheetFunction.Match("key990000", ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000"), 0)
  Debug.Print Application.WorksheetFunction.Index(ThisWorkbook.Worksheets("Sheet1").Range("B1:B1000000"), rw)
  'no difference from:
  'Debug.Print ThisWorkbook.Worksheets("Sheet1").Cells(rw, 2)
  Debug.Print Timer - timer0

End Sub

---

Sub loop_in_array()
  Dim timer0 As Single
  Dim myArray1() As Variant
  Dim i As Long

  timer0 = Timer()

  'Reading rows takes the majority of time
  myArray1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000").Value

  'For 1m unsorted rows the following part takes only 0.06s when the key is near the end
  For i = 1 To UBound(myArray1, 1)
    If myArray1(i, 1) = "key990000" Then
      Debug.Print ThisWorkbook.Worksheets("Sheet1").Cells(i, 2).Value
      Exit For
    End If
  Next

  Debug.Print Timer - timer0

End Sub

---

Sub range_find()
  Dim timer0 As Single
  Dim rngFound As Range

  timer0 = Timer()

  Set rngFound = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000").Find("key990000", , xlValues, xlWhole)

  Debug.Print rngFound.Offset(0, 1).Value
  Debug.Print Timer - timer0

End Sub

---

Sub match_in_array()
  Dim timer0 As Single
  Dim myArray1() As Variant
  Dim lngRow As Long

  timer0 = Timer()

  'Reading rows takes half of the time
  myArray1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000").Value

  'For 1m unsorted rows the following part takes 0.45s when the key is near the end
  lngRow = Application.WorksheetFunction.Match("key990000", myArray1, 0)
  Debug.Print ThisWorkbook.Worksheets("Sheet1").Cells(lngRow, 2)
  Debug.Print Timer - timer0

End Sub

---

Sub loop_in_sheet()
  Dim timer0 As Single
  Dim i As Long
  Dim cell As Range

  timer0 = Timer()

  For Each cell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000")
    If cell.Value = "key990000" Then
      Debug.Print ThisWorkbook.Worksheets("Sheet1").Range("B" & cell.Row).Value
      Exit For
    End If
  Next

  Debug.Print Timer - timer0

End Sub

---

Sub array_to_dict()
  Dim timer0 As Single
  Dim myArray1() As Variant
  Dim dict As Object
  Dim i As Long

  timer0 = Timer()

  myArray1 = ThisWorkbook.Worksheets("Sheet1").Range("A1:B1000000").Value

  Set dict = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(myArray1, 1)
    dict(myArray1(i, 1)) = myArray1(i, 2)
  Next

  Debug.Print dict("key990000")
  Debug.Print Timer - timer0

  Set dict = Nothing
End Sub

---

Sub sheet_to_dict()
  Dim timer0 As Single
  Dim dict As Object
  Dim cell As Range

  timer0 = Timer()

  Set dict = CreateObject("Scripting.Dictionary")
  For Each cell In ThisWorkbook.Worksheets("Sheet1").Range("A1:A1000000")
    dict(cell.Value) = ThisWorkbook.Worksheets("Sheet1").Range("B" & cell.Row).Value
  Next

  Debug.Print dict("key990000")
  Debug.Print Timer - timer0

  Set dict = Nothing
End Sub