VBA for Lookup to other Columns

[Know Enough to be Dangerous]

Hello-

I am hoping someone can help me. I'm having a hard time coming up
with the proper code to solve the following problem.

I need to populate column H (starting with cell H8) with an amount
that can be in 1 of 12 different columns to the right. Which column
of data to pull back is dependent on the number in column F. Here's
an example:

If cell F8 contains the number 1, the amount in cell H8 needs to come
from column Y and same row number (e.g., Y8). If cell F8 contains the
number 2, the amount in cell H8 needs to come from column Z and the
same row number (e.g., Z8). As you'd guess a 3 in F results in
returning the number from AA and so on. Column F will only contain
the number range of 1 - 12.

Below is chart outling the number in column F and the associated
column to pull from to populate H:
1=Y
2=Z
3=AA
4=AB
5=AC
6=AD
7=AE
8=AF
9=AG
10=AH
11=AI
12=AJ

The code would need to loop for every non-blank cell in column F
starting with cell F8. The range this would be applied to is
variable, so it would have to loop until it finds a blank in column F.

Thank you very much in advance.

 

[JLGWhiz]

I didn't use Lookup but it does what you described. See if it is what you
really want. If not make a new posting with this code an explain what it did
not do and what you want it to do.

Sub title()
Dim lr As Long, sh As Worksheet, c As Range, srcRange As Range
Set sh = ActiveSheet

lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
Set srcRng = sh.Range("F8:F" & lr)
For Each c In srcRng
Select Case c.Value
Case 1
sh.Range("Y" & c.Row).Copy sh.Range("H" & c.Row)
Case 2
sh.Range("z" & c.Row).Copy sh.Range("H" & c.Row)
Case 3
sh.Range("AA" & c.Row).Copy sh.Range("H" & c.Row)
Case 4
sh.Range("AB" & c.Row).Copy sh.Range("H" & c.Row)
Case 5
sh.Range("AC" & c.Row).Copy sh.Range("H" & c.Row)
Case 6
sh.Range("AD" & c.Row).Copy sh.Range("H" & c.Row)
Case 7
sh.Range("AE" & c.Row).Copy sh.Range("H" & c.Row)
Case 8
sh.Range("AF" & c.Row).Copy sh.Range("H" & c.Row)
Case 9
sh.Range("AG" & c.Row).Copy sh.Range("H" & c.Row)
Case 10
sh.Range("AH" & c.Row).Copy sh.Range("H" & c.Row)
Case 11
sh.Range("AI" & c.Row).Copy sh.Range("H" & c.Row)
Case 12
sh.Range("AJ" & c.Row).Copy sh.Range("H" & c.Row)
End Select
Next
End Sub

I am assuming you know how to install the code in the module1 code window,
and to run it.

 

[AndrewCerritos]

Hi, here is my take on this:

Private Sub FillColH()
Dim celX As Range ' looping cell variable
Set celX = ActiveSheet.[F8] ' starting cell
Do While celX.Value <> "" ' loop until blank cell
' col.H is 2 columns from col.F
' col.Y is 19 columns from col.F; 19-1=18
celX.Offset(0, 2).Value = celX.Offset(0, celX.Value + 18).Value
Set celX = celX.Offset(1, 0)
Loop
End Sub

Regards,
Andrew

 

[JLGWhiz]

I suppose it is a matter of the OP understanding the code. A more controlled
loop would be:

Sub stitute()
Dim lr As Long, sh As Worksheet, c As Range, srcRange As Range
Set sh = ActiveSheet
lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
Set srcRng = sh.Range("F8:F" & lr)
For Each c In srcRng
c.Offset(0, 2) = sh.Cells(c.Row, c.Value + 24)
Next
End Sub

Hi, here is my take on this:

Private Sub FillColH()
Dim celX As Range ' looping cell variable
Set celX = ActiveSheet.[F8] ' starting cell
Do While celX.Value <> "" ' loop until blank cell
' col.H is 2 columns from col.F
' col.Y is 19 columns from col.F; 19-1=18
celX.Offset(0, 2).Value = celX.Offset(0, celX.Value + 18).Value
Set celX = celX.Offset(1, 0)
Loop
End Sub

Regards,
Andrew

I didn't use Lookup but it does what you described. See if it is what you
really want. If not make a new posting with this code an explain what it did
not do and what you want it to do.

Sub title()
Dim lr As Long, sh As Worksheet, c As Range, srcRange As Range
Set sh = ActiveSheet

lr = sh.Cells(Rows.Count, 6).End(xlUp).Row
Set srcRng = sh.Range("F8:F" & lr)
For Each c In srcRng
Select Case c.Value
Case 1
sh.Range("Y" & c.Row).Copy sh.Range("H" & c.Row)
Case 2
sh.Range("z" & c.Row).Copy sh.Range("H" & c.Row)
Case 3
sh.Range("AA" & c.Row).Copy sh.Range("H" & c.Row)
Case 4
sh.Range("AB" & c.Row).Copy sh.Range("H" & c.Row)
Case 5
sh.Range("AC" & c.Row).Copy sh.Range("H" & c.Row)
Case 6
sh.Range("AD" & c.Row).Copy sh.Range("H" & c.Row)
Case 7
sh.Range("AE" & c.Row).Copy sh.Range("H" & c.Row)
Case 8
sh.Range("AF" & c.Row).Copy sh.Range("H" & c.Row)
Case 9
sh.Range("AG" & c.Row).Copy sh.Range("H" & c.Row)
Case 10
sh.Range("AH" & c.Row).Copy sh.Range("H" & c.Row)
Case 11
sh.Range("AI" & c.Row).Copy sh.Range("H" & c.Row)
Case 12
sh.Range("AJ" & c.Row).Copy sh.Range("H" & c.Row)
End Select
Next
End Sub

I am assuming you know how to install the code in the module1 code window,
and to run it.

 

[Know Enough to be Dangerous]

Thank you all. These solved the problem. Again, many thanks.