Transfer range to array etc.

  • Thread starter Thread starter AD108
  • Start date Start date
A

AD108

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
 
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
 
The variables x and y are not shown dimmed, but assuming variants.
You should be getting a subscript out of range error on the line :
..Cells(intPos, 11) = y(i)
because the array is 2D. You have the correct syntax for x, so the same for
y

However, you do not need 2 arrays ; you can dump the 2 columns in 1 array
x = Range("BS9:BT300")
and
.Cells(intPos, 11) = x(i,2)

NickHK
 
AD108 said:
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
Click to expand...

Several errors:

#1 -- Your IsError() statement doesn't do anything -- If intPos does
have an error, your Application.Match statement will terminate the
routine.
#2 -- As is, the only way the Match routine can have an error is if
every cell in the 2nd column is empty. You have to add the 3rd
parameter to tell it you want an exact match.
#3 -- You're referring to y() as a 1-dimensional array. It's
2-dimensional

If I understood your description correctly, I think what you want is:

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

I'm not sure why you couldn't "track down" the errors. They were
either flagged by VBA during line by line execution or by watching the
value of "intPos" in the watch window.
 
Thanks,

That worked
Nigel said:
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
Click to expand...
 
Back
Top