Ggtcf

I need to do a Vlookup of an ID on the source sheet to a table in the data sheet. When the Vlookup is done, it needs to return the cell values from 6 different columns.

Here I have a function to get the range:

Function find_Col(header As String) As Range

 Dim aCell As Range, rng As Range, def_Header As Range
 Dim col As Long, lRow As Long, defCol As Long
 Dim colName As String, defColName As String
 Dim y As Workbook
 Dim ws1 As Worksheet

 Set y = Workbooks("Template.xlsm")
 Set ws1 = y.Sheets("Results")

 With ws1

 Set def_Header = Cells.Find(what:="ID", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
 Set aCell = .Range("B2:Z2").Find(what:=header, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)

 If Not aCell Is Nothing Then

 defCol = def_Header.Column
 defColName = Split(.Cells(, defCol).Address, "$")(1)

 col = aCell.Column
 colName = Split(.Cells(, col).Address, "$")(1)

 lRow = Range(defColName & .Rows.count).End(xlUp).Row - 1

 Set myCol = Range(colName & "2")

 'This is your range
 Set find_Col = Range(myCol.Address & ":" & colName & lRow).Offset(1, 0)

 'If not found
 Else

 MsgBox "Column Not Found"

 End If

 End With

End Function

Then in my sub, I select the range and do a Vlookup which fills this range:

Selection.FormulaR1C1 = "=VLOOKUP(RC[-4],myTable,2,FALSE)"

And this works great.

Then I needed to return more than just one column, so I ended up with the formula:

Selection.FormulaArray = "=VLOOKUP($C3,myTable,2,3,4,5,6,FALSE)"

Source Sheet:

Data Sheet:

So, my function returns only the range for one column, which I think I can use in terms of getting a row count then using something like this:

Set myRng = find_Col("Product")

For currentRow = myRng.Rows.count To 1 Step -1

Selection.FormulaArray = "=VLOOKUP($C3,myTable,2,3,4,5,6,FALSE)"

Next currentRow

Then perhaps instead of C3 it could look something like this:

C & currentRow --> Selection.FormulaArray = "=VLOOKUP($C & currentRow,myTable,2,3,4,5,6,FALSE)"

But then I have the issue that only one cell is selected (G3) and from H-L is not. And I have no idea whether this is even a plausible effort.

Ideally of course, I would have cells G3:L3 selected and fill the formula down to the last row.

My brain is just fried from all the thinking and attempts.

So this should do the trick... I've explained every instance but if you need help understanding just ask:

Option Explicit
Sub FillData1()

 Dim ws As Worksheet, wsData As Worksheet, arr As Variant, arrData As Variant
 Dim DictHeaders As Scripting.Dictionary, DictIds As Scripting.Dictionary, DictDataHeaders As Scripting.Dictionary, _
 DictDataIds As Scripting.Dictionary
 Dim LastRow As Long, LastCol As Integer, i As Long, j As Integer

 With Application
 .ScreenUpdating = False
 .EnableEvents = False
 End With

 With ThisWorkbook
 Set ws = .Sheets("Results")
 Set wsData = .Sheets("List")
 End With

 'Lets suppose your data always starts on row 2 in both sheets and column B will always have the max amount of rows filled
 With ws 'filling the first array
 LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
 LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
 arr = .Range("B2", .Cells(LastRow, LastCol)).Value
 End With

 With wsData 'filling the data array
 LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row
 LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
 arrData = .Range("A2", .Cells(LastRow, LastCol)).Value
 End With

 'Now lets put everything into Dictionaries so if the data moves columns or rows won't matter
 Set DictHeaders = New Scripting.Dictionary
 Set DictIds = New Scripting.Dictionary
 For i = 1 To UBound(arr, 2) 'this will fill the headers positions on the main sheet
 If Not DictHeaders.Exists(arr(1, i)) Then DictHeaders.Add arr(1, i), i
 Next i
 For i = 2 To UBound(arr, 1) 'this will fill the IDs positions on the main sheet
 If Not DictIds.Exists(arr(i, DictHeaders("KW ID"))) Then DictIds.Add arr(i, 1), i
 Next i

 Set DictDataHeaders = New Scripting.Dictionary
 Set DictDataIds = New Scripting.Dictionary
 For i = 1 To UBound(arrData, 2) 'this will fill the headers positions on the data sheet
 If Not DictDataHeaders.Exists(arrData(1, i)) Then DictDataHeaders.Add arrData(1, i), i
 Next i
 For i = 2 To UBound(arrData, 1) 'this will fill the IDs positions on the data sheet
 If Not DictDataIds.Exists(arrData(i, DictDataHeaders("KW ID"))) Then DictDataIds.Add arrData(i, DictDataHeaders("KW ID")), i
 Next i

 'Finally will loop through the main array to fill it with the data from the data array
 On Error Resume Next
 For i = 2 To UBound(arr)
 For j = 6 To UBound(arr, 2) 'I'm assuming you want to avoid the first columns which are hidden
 arr(i, j) = arrData(DictDataIds(arr(i, 1)), DictDataHeaders(arr(1, j)))
 Next j
 Next i
 On Error GoTo 0

 With ws 'filling the first array
 LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
 LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
 .Range("B2", .Cells(LastRow, LastCol)).Value = arr
 End With

 With Application
 .ScreenUpdating = True
 .EnableEvents = True
 End With

End Sub

I don't know if I got the true issue of your goal. However, since your Selection parts in your code should be avoid, why don't make something like the following?

Set myRng = find_Col("Product")

For currentRow = myRng.Rows.count To 1 Step -1

 Range(Cells(currentRow, 5), Cells(currentRow, 9)).FormulaArray = "=VLOOKUP(RC3,myTable,2,3,4,5,6,FALSE)"

Next currentRow