This works - but not sure if you get the results you expect?

Sub Honolulu()
Dim intPos As Integer
Dim i As Integer, x As Variant, y As Variant
x = Range("BS9:BS300")
y = Range("BT9:BT300")
i = 1
For i = 1 To UBound(x)
intPos = Application.Match(x(i, 1), ActiveSheet.Columns(2))
If Not IsError(intPos) Then
With ActiveSheet
.Cells(intPos, 11) = y(i, 1)
End With
End If
Next i

End Sub

--
Cheers
Nigel



"AD108" wrote in message
...
I am trying to use the following code to:

Transfer a 2 column range into "vertical arrays" two arrays
Find each element of the 1st array in a worksheet range
Print the corresponding element in the second array into a cell offset
from
the range

My code is not working. I am getting an error that I can't track down.

Sub Honolulu()
Dim intPos As Integer
Dim i As Integer
x = Range("BS9:BS300")
y = Range("BT9:BT300")
i = 1
For i = 1 To UBound(x, 1)
intPos = Application.Match(x(i, 1), ActiveSheet.Columns(2))
If Not IsError(intPos) Then
With ActiveSheet
.Cells(intPos, 11) = y(i)
End With
End If
Next i

End Sub

Thanks is advance