Sub FindMatches() Dim d As Object, rw As Range, k 'create the row map Set d = GetRowLookup(Sheets("Sheet1").Range("A2:C10000")) 'run lookups on the row map '(same data I used to create the map, but randomly-sorted) For Each rw In Sheets("sheet2").Range("A2:C10000").Rows k = GetKey(rw) If d.exists(k) Then rw.Cells(3).Offset(0, 1).Value = d(k) Next rw End Sub 'create a dictionary lookup based on three column values Function GetRowLookup(rng As Range) Dim d As Object, k, rw As Range Set d = CreateObject("scripting.dictionary") For Each rw In rng.Rows k = GetKey(rw) d.Add k, rw.Cells(1).Row 'not checking for duplicates! Next rw Set GetRowLookup = d End Function 'create a key from a given row Function GetKey(rw As Range) GetKey = rw.Cells(1).Value & Chr(0) & rw.Cells(2).Value & _ Chr(0) & rw.Cells(3).Value End Function 

Sub FindMatches() Dim d As Object, rw As Range, k, t Dim arr, arrOut, nR, n t = Timer 'create the row map (40k rows) Set d = GetRowLookup(Sheets("Sheet1").Range("A2:C40001")) Debug.Print Timer - t, "map" t = Timer 'run lookups on the row map '(same values I used to create the map, but randomly-sorted) For Each rw In Sheets("sheet2").Range("A2:C480000").Rows k = GetKey(rw) If d.exists(k) Then rw.Cells(3).Offset(0, 1).Value = d(k) Next rw    Debug.Print Timer - t, "slow version"  t = Timer 'run lookups again - faster version arr = Sheets("sheet2").Range("A2:C480000").Value nR = UBound(arr, 1) ReDim arrOut(1 To nR, 1 To 1) For n = 1 To nR k = arr(n, 1) & Chr(0) & arr(n, 2) & Chr(0) & arr(n, 3) If d.exists(k) Then arrOut(n, 1) = d(k) Next n Sheets("sheet2").Range("D2").Resize(nR, 1).Value = arrOut Debug.Print Timer - t, "fast version" End Sub  'create a dictionary lookup based on three column values Function GetRowLookup(rng As Range) Dim d As Object, k, rw As Range Set d = CreateObject("scripting.dictionary") For Each rw In rng.Rows k = GetKey(rw) d.Add k, rw.Cells(1).Row 'not checking for duplicates! Next rw Set GetRowLookup = d End Function 'create a key from a given row Function GetKey(rw As Range) GetKey = rw.Cells(1).Value & Chr(0) & rw.Cells(2).Value & _ Chr(0) & rw.Cells(3).Value End Function 

For performance you're hard-pressed to beat a Dictionary-based lookup table:

Sub FindMatches() Dim d As Object, rw As Range, k 'create the row map Set d = GetRowLookup(Sheets("Sheet1").Range("A2:C10000")) 'run lookups on the row map For Each rw In Sheets("sheet2").Range("A2:C10000").Rows k = GetKey(rw) If d.exists(k) Then rw.Cells(3).Offset(0, 1).Value = d(k) Next rw End Sub 'create a dictionary lookup based on three column values Function GetRowLookup(rng As Range) Dim d As Object, k, rw As Range Set d = CreateObject("scripting.dictionary") For Each rw In rng.Rows k = GetKey(rw) d.Add k, rw.Cells(1).Row 'not checking for duplicates! Next rw Set GetRowLookup = d End Function 'create a key from a given row Function GetKey(rw As Range) GetKey = rw.Cells(1).Value & Chr(0) & rw.Cells(2).Value & _ Chr(0) & rw.Cells(3).Value End Function 

For performance you're hard-pressed to beat a Dictionary-based lookup table:

Sub FindMatches() Dim d As Object, rw As Range, k 'create the row map Set d = GetRowLookup(Sheets("Sheet1").Range("A2:C10000")) 'run lookups on the row map '(same data I used to create the map, but randomly-sorted) For Each rw In Sheets("sheet2").Range("A2:C10000").Rows k = GetKey(rw) If d.exists(k) Then rw.Cells(3).Offset(0, 1).Value = d(k) Next rw End Sub 'create a dictionary lookup based on three column values Function GetRowLookup(rng As Range) Dim d As Object, k, rw As Range Set d = CreateObject("scripting.dictionary") For Each rw In rng.Rows k = GetKey(rw) d.Add k, rw.Cells(1).Row 'not checking for duplicates! Next rw Set GetRowLookup = d End Function 'create a key from a given row Function GetKey(rw As Range) GetKey = rw.Cells(1).Value & Chr(0) & rw.Cells(2).Value & _ Chr(0) & rw.Cells(3).Value End Function