Hello David,

Thanks for this hint.

My sub shown below needs 1 minute for 1560 lookups in a table with
1560 stores.

Regards,
Bernd

Sub closest_store(rMyStates As Range, _
rMySales As Range, _
rAllStates As Range, _
rAllSales As Range, _
rAllStores As Range, _
rOutputStores As Range, _
rOutputSales As Range)
'Fills store names in rOutputStores (and sales figures
'in rOutputSales) after looking
'up for each state in rMyStates corresponding state
'in rAllStates with sales from rAllSales with
'least diff to rMySales.
Dim dMin As Double
Dim dCurrDiff As Double
Dim i As Long, j As Long, k As Long
Dim vR(1 To 2) As Variant
Dim collStores As New Collection
Dim CalcModus As Long
Dim UpdateModus As Long

CalcModus = Application.Calculation
Application.Calculation = xlCalculationManual
UpdateModus = Application.ScreenUpdating
Application.ScreenUpdating = False
On Error Resume Next 'Necessary for collection lookup
rOutputStores.ClearContents
rOutputSales.ClearContents
For i = 1 To rMyStates.Count
If i Mod 100 = 0 Then
Application.StatusBar = "Looking for closest store " _
& i & " of " & rMyStates.Count
End If
vR(1) = " No state matches <<<"
vR(2) = 0#
dMin = 1E+300 'Nothing found so far
For j = 1 To rAllStates.Count
If rMyStates(i) = rAllStates(j) Then
Err.Clear
k = collStores("X" & rAllStores(j))
If Err.Number < 0 Then
dCurrDiff = Abs(rMySales(i) - rAllSales(j))
If dMin dCurrDiff Then
vR(1) = rAllStores(j)
vR(2) = rAllSales(j)
dMin = dCurrDiff
End If
End If
End If
Next j
rOutputStores(i) = vR(1)
rOutputSales(i) = vR(2)
collStores.Add i, "X" & vR(1)
Next i
Application.StatusBar = False
Application.Calculation = CalcModus
Application.ScreenUpdating = UpdateModus
End Sub

Sub test()
Call closest_store( _
Sheets("Sheet2").Range("B2:B1568"), _
Sheets("Sheet2").Range("C2:C1568"), _
Sheets("Sheet3").Range("B2:B1569"), _
Sheets("Sheet3").Range("C2:C1569"), _
Sheets("Sheet3").Range("A2:A1569"), _
Sheets("Sheet2").Range("D2:D1568"), _
Sheets("Sheet2").Range("E2:E1568"))
End Sub