Array Code issue

[h2fcell]

I'm using the below code to populate the selected range with a vlookup.

Set Cherries = Worksheets("Main").Range("G559, K559, O559, S559, W559,
AA559, AE559, AI559, AM559, AQ559, AU559, AY559, BC559")
Set Pickles = Worksheets("Main").Range("G592, K592, O592, S592, W592, AA592,
AE592, AI592, AM592, AQ592, AU592, AY592, BC592")
Set Olives = Worksheets("Main").Range("G625, K625, O625, S625, W625, AA625,
AE625, AI625, AM625, AQ625, AU625, AY625, BC625")
Set Condiments = Worksheets("Main").Range("G658, K658, O658, S658, W658,
AA658, AE658, AI658, AM658, AQ658, AU658, AY658, BC658")
Set allProducts = Union(Cherries, Pickles, Olives, Condiments)
allProducts.Select
Selection.Value = "=VLOOKUP($B$1,Table2,Commission!C$1)"

The cells are populated with the vlookup but the column piece,
Commission!C$1, changes the same number of columns as the range selection
skips.

For instance I get:
G559 =VLOOKUP($B$1,Table2,Commission!C$1)
K559 =VLOOKUP($B$1,Table2,Commission!G$1)
O559 =VLOOKUP($B$1,Table2,Commission!K$1).....

What I need is:
G559 =VLOOKUP($B$1,Table2,Commission!C$1)
K559 =VLOOKUP($B$1,Table2,Commission!D$1)
O559 =VLOOKUP($B$1,Table2,Commission!E$1).....
or
G559 =VLOOKUP($B$1,Table2, 3)
K559 =VLOOKUP($B$1,Table2, 4)
O559 =VLOOKUP($B$1,Table2, 5).....

I'm not sure what I should use to accomplish this.
Any suggestions?
Thanks.

 

[Peter T]

You'll need to process one by one, here's one way

Sub test()
Dim i As Long, j As Long
Dim sf As String
Dim rFood As Range, rCol As Range, celIdx As Range
Dim arrRng(0 To 3) As Range
Set arrRng(0) = Worksheets("Main").Range("G559, K559, O559, S559,
W559,AA559, AE559, AI559, AM559, AQ559, AU559, AY559, BC559")
Set arrRng(1) = Worksheets("Main").Range("G592, K592, O592, S592, W592,
AA592,AE592, AI592, AM592, AQ592, AU592, AY592, BC592")
Set arrRng(2) = Worksheets("Main").Range("G625, K625, O625, S625, W625,
AA625,AE625, AI625, AM625, AQ625, AU625, AY625, BC625")
Set arrRng(3) = Worksheets("Main").Range("G658, K658, O658, S658,
W658,AA658, AE658, AI658, AM658, AQ658, AU658, AY658, BC658")

sf = "=VLOOKUP($B$1,Table2,Commission!adrs)"
Set celIdx = Range("C1")
For i = 0 To UBound(arrRng)
j = 0
For Each rCol In arrRng(i).Columns
rCol.Formula = Replace(sf, "adrs", celIdx.Offset(, j).Address)
j = j + 1
Next
Next

End Sub

One advantage, with entirely absolute addressing there's no need to select
the multi range before applying the formula.

Regards,
Peter T

 

[Peter T]

For your particular scenario, with cells spaced evenly along rows & columns,
this seems simpler

Sub test2()
Dim j As Long, a As Long, b As Long
Dim sf As String
Dim rFirst As Range, celIdx As Range

sf = "=VLOOKUP($B$1,Table2,Commission!adrs)"
Set celIdx = Range("C1")

Set rFirst = Worksheets("Main").Range("G559")
For a = 0 To 4
j = 0
For b = 0 To 12
rFirst.Offset(a * 33, b * 4).Formula = _
Replace(sf, "adrs", celIdx.Offset(, j).Address)
j = j + 1
Next
Next

End Sub


Regards,
Peter T