Sub Test1() '~1st way from OP....
'enters R1C1 formula into results range then
' converts formulas to values
Dim x As Long, lr As Long
lr = Worksheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row
With Range("G2:G" & lr)
.FormulaR1C1 = "=VLOOKUP(RC[-1],R2C1:R1762C3,3,False)"
.Value = .Value
End With
End Sub
Sub Test2() '~2nd way from OP....
'--Reads lookup values from range then
' writes results of individual vlookups
' directly to cells
Dim x As Long, lr As Long
Dim sValue As String
Dim vLookupTable As Variant
Dim vAnswer As Variant
lr = Worksheets("Sheet1").Cells(Rows.Count, "F").End(xlUp).Row
On Error Resume Next
For x = 2 To lr
sValue = Cells(x, "F").Value
vLookupTable = Range("A2:C1762")
vAnswer = Application.VLookup(sValue, vLookupTable, 3, False)
Cells(x, "G").Value = vAnswer
Next x
On Error GoTo 0
End Sub
Sub Test3()
'--Reads lookup values into array then
' writes results of individual vlookups
' directly to cells
Dim i As Long
Dim sValue As String
Dim vLookupValues As Variant
Dim vLookupTable As Variant
With Sheets("Sheet1")
vLookupTable = .Range("A2:C1762").Value
vLookupValues = .Range("F2:F" & _
.Cells(.Rows.Count, "F").End(xlUp).Row).Value
For i = LBound(vLookupValues) To UBound(vLookupValues)
.Cells(i + 1, "G") = Application.VLookup( _
vLookupValues(i, 1), vLookupTable, 3, False)
Next i
End With
End Sub
Sub Test4()
'--Reads lookup values into array then
' stores results of individual vlookups in array
' then transfers array values to cells in one write
Dim i As Long
Dim sValue As String
Dim vLookupValues As Variant
Dim vLookupTable As Variant
With Sheets("Sheet1")
vLookupTable = .Range("A2:C1762").Value
vLookupValues = .Range("F2:F" & _
.Cells(.Rows.Count, "F").End(xlUp).Row).Value
For i = LBound(vLookupValues) To UBound(vLookupValues)
vLookupValues(i, 1) = Application.VLookup( _
vLookupValues(i, 1), vLookupTable, 3, False)
Next i
.Range("G2").Resize(UBound(vLookupValues), 1) = vLookupValues
End With
End Sub
Sub Test5()
'--Reads lookup table into dictionary
' Reads lookup values into array then
' stores results of dictionary lookups in array
' then transfers array values to cells in one write
'--requires library reference to MS Scripting Runtime
Dim dicLookupTable As Scripting.Dictionary
Dim i As Long
Dim sKey As String
Dim vLookupValues As Variant
Dim vLookupTable As Variant
Set dicLookupTable = New Scripting.Dictionary
dicLookupTable.CompareMode = vbTextCompare
With Sheets("Sheet1")
vLookupTable = .Range("A2:C1762").Value
For i = LBound(vLookupTable) To UBound(vLookupTable)
sKey = vLookupTable(i, 1)
If Not dicLookupTable.Exists(sKey) Then _
dicLookupTable(sKey) = vLookupTable(i, 3)
Next i
vLookupValues = .Range("F2:F" & _
.Cells(.Rows.Count, "F").End(xlUp).Row).Value
For i = LBound(vLookupValues) To UBound(vLookupValues)
sKey = vLookupValues(i, 1)
If dicLookupTable.Exists(sKey) Then
vLookupValues(i, 1) = dicLookupTable(sKey)
Else
vLookupValues(i, 1) = CVErr(xlErrNA)
End If
Next i
.Range("G2").Resize(UBound(vLookupValues) - _
LBound(vLookupValues) + 1, 1) = vLookupValues
End With
End Sub
