Double FOR loop takes a while to complete - excel

Question

I need to compare 2 cells in different sheets and get a value if there's a match. I currently have this piece of code, it each cell in column B is checked to each cell in column A and if there's a match the corresponding cell in column C is copied. So far so good, the problem is, it takes a long time to do so. I only have 750 records in column B and 4000 in column A.
Are there ways to optimize the code so it runs faster?
For i = 2 To LastRow
For j = 2 To LastRowJ
If Sheets("tempsheet").Range("B" & i).Value = Sheets("tempsheet").Range("A" & j).Value Then
Range("Q" & i).Value = Sheets("tempsheet").Range("C" & j).Value
End If
Next j
Next i

Answer 1

Here are 6 measurements:
1. copyValsCell1(): 90.78125 sec (posted code)
2. copyValsCell2(): 53.27343 sec (ws object)
3. copyValsCell3(): 52.67187 sec (With statement, and screen off)
4. copyValsArr(): 0.60937 sec (Array - no restrictions)
5. copyValsDictCell(): 0.07812 sec (Dictionary with Range - unique values only)
6. copyValsDictArr(): 0.03125 sec (Dictionary with Array - unique values only)
In my test file I had all values on the same sheet (lr = 4000: lrj = 750)
.
Initial code - Duration copyValsCell1(): 90.78125 sec
ws object
Set ws = Sheets("tempsheet")
For i = 2 To lr 'Duration copyValsCell2(): 53.2734375 sec
For j = 2 To lrj
If ws.Range("B" & i).Value = ws.Range("A" & j).Value Then
ws.Range("Q" & i).Value = ws.Range("C" & j).Value
End If
Next
Next
With statement, and screen off
Set ws = Sheets("tempsheet")
Application.ScreenUpdating = False
For i = 2 To lr 'Duration copyValsCell3(): 52.671875 sec
For j = 2 To lrj
With ws
If .Range("B" & i).Value2 = .Range("A" & j).Value2 Then
.Range("Q" & i).Value2 = .Range("C" & j).Value2
End If
End With
Next
Next
Application.ScreenUpdating = True
Array
Dim v As Variant
v = Sheets("tempsheet").Range("A1:Q4000")
For i = 2 To lr 'Duration copyValsArr(): 0.609375 sec
For j = 2 To lrj
If v(i, 2) = v(j, 1) Then v(i, 17) = v(j, 3)
Next
Next
Sheets("tempsheet").Range("A1:Q4000") = v
Dictionary with Range (requires reference to Microsoft Scripting Runtime library)
Set d = New Dictionary: Set ws = Sheets("tempsheet")
For i = 2 To lrj 'Duration copyValsDictCell(): 0.078125 sec
d(ws.Range("A" & i).Value2) = i
Next
For i = 2 To lr
If d.Exists(ws.Range("B" & i).Value) Then
ws.Range("Q" & i).Value = ws.Range("C" & d(ws.Range("B" & i).Value)).Value
End If
Next
Dictionary with Array (requires reference to Microsoft Scripting Runtime library)
Dim v As Variant
v = Sheets("tempsheet").Range("A1:Q4000")
Set d = New Dictionary 'Duration copyValsDictArr(): 0.03125 sec
For i = 2 To lrj
d(v(i, 1)) = i
Next
For i = 2 To lr
If d.Exists(v(i, 2)) Then v(i, 17) = v(d(v(i, 2)), 3)
Next
Sheets("tempsheet").Range("A1:Q4000") = v

Answer 2

Try this:
For i = 2 To LastRow
Set match_check = Sheets("tempsheet").Range("A:A").Find(Sheets("tempsheet").Range("B" & i), Lookat:=xlWhole)
If Not match_check Is Nothing Then Range("Q" & i) = match_check.Offset(0,2)
Next i
Find returns a Range object of the first found match in the column and Nothing if no match is found. I didn't check the run time but it should be faster than the double for loop.

Answer 3

You could use a dictionary keyed to the values in Column A -- assuming that these values are all distinct (otherwise your code itself doesn't quite make sense. Include a reference to Microsoft Scripting Runtime (via Tools/References in the VBA editor). The following code should be over 100 times as fast as what you currently have:
Sub test()
Dim LastRow As Long, LastRowJ As Long
Dim i As Long, j As Long
Dim AVals As New Dictionary
LastRow = Sheets("tempsheet").Cells(Rows.Count, "B").End(xlUp).Row()
LastRowJ = Sheets("tempsheet").Cells(Rows.Count, "A").End(xlUp).Row()
For j = 2 To LastRowJ
AVals.Add Sheets("tempsheet").Range("A" & j).Value, j
Next j
For i = 2 To LastRow
If AVals.Exists(Sheets("tempsheet").Range("B" & i).Value) Then
j = AVals(Sheets("tempsheet").Range("B" & i).Value)
Range("Q" & i).Value = Sheets("tempsheet").Range("C" & j).Value
End If
Next i
End Sub