Vlookup Col_Index_Number by Header based on Array iteration? - arrays

Question

I am running into an issue with my current code - I am hoping someone can assist:
Issue: I am trying to do a Vlookup from Workbook "ABC". The issue is, I am trying to change the VLOOKUP Col_Index_Number based on a header on workbook ABC...
So for example: For MyArray "Food" I am looking to Vlookup Column_Index_Num for "Food-Mexican" Column on workbook ABC, For MyArray Appetizers, I am looking to Vlookup Column_Index-Num for "Appetizers-American"...
Additionally, the columns will not always be in the same place for each report so it has to be based on the row 1 header of ABC workbook.
Also, sometimes the Array iteration might be skipped, if say for example, "Non-AlcoholicDrinks" is not found.
Sub WIP()
Dim wb As Workbook
Dim wsMain As Worksheet
Dim wsLookup As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim rFind1 As Range
Dim rFind2 As Range
Dim rFind3 As Range
Dim MyArray As Variant
Dim LookupHeaders As Variant
Dim LookupHeaders2 As Variant
Dim LR As Long
Dim i As Long
Dim PriceCol As Long
Dim pricecol2 As Long
Dim LastColumn As Long
Dim LastColumn2 As Long
Dim LastColumn3 As Long
Dim LastColumn4 As Long
Dim IndexCol As Long
'Unformatted Price Row
Sheets("Consolidate List").Select
LR = Range("A" & Rows.Count).End(xlUp).Row
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("J:N").Delete
Columns("J:J").Select
ActiveWindow.FreezePanes = True
Range("H2").Select
ActiveCell.FormulaR1C1 = "New Price"
ActiveCell.Interior.ColorIndex = 22
Range("H3:H" & LR).Formula = "=VLOOKUP(RC[-7],'Connect Report'!C[-7]:C[-6],2,FALSE)"
ActiveCell.EntireColumn.Resize(Rows.Count - 2).Offset(2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I2").Select
ActiveCell.FormulaR1C1 = "Difference"
ActiveCell.Interior.ColorIndex = 22
Range("I3:I" & LR).Formula = "=IF(OR(OR(RC[-2]="""",RC[-1]="""",RC[-1]=""x"",)),"""",RC[-1]-RC[-2])"
ActiveCell.EntireColumn.Resize(Rows.Count - 2).Offset(2).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set wb = ActiveWorkbook
Sheets("Consolidate List").Select
Set wsMain = wb.ActiveSheet
Set wsLookup = wb.Sheets("Connect Report") '<-- Change to correct sheet name for the Lookup sheet
LR = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row
MyArray = Array("US", "SPAIN", "California")
LookupHeaders = Array("TTIER", "Time333", "Round6")
LookupHeaders2 = Array("TELLER5", "Fly7", "Mine4")
For i = LBound(MyArray) To UBound(MyArray)
With wsMain.Rows(1)
Set rFind1 = .Find(What:=MyArray(i), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind1 Is Nothing Then
Set rng = rFind1.Offset(1).Resize(, 8)
PriceCol = Application.Match("New Opposed Price", rng, 0)
LastColumn = rFind1.Column + PriceCol
If wsMain.Cells(rng.Row, LastColumn) <> "New Opposed Price" Then
wsMain.Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng.Row, LastColumn).Value = "New Opposed Price"
wsMain.Cells(rng.Row, LastColumn).Interior.ColorIndex = 22
LastColumn2 = LastColumn + 1
wsMain.Columns(LastColumn2).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng.Row, LastColumn2).Value = "Difference"
wsMain.Cells(rng.Row, LastColumn2).Interior.ColorIndex = 22
Set rFind2 = wsLookup.Rows(1).Find(LookupHeaders(i), wsLookup.Range("A1"), xlValues, xlWhole)
If Not rFind2 Is Nothing Then
IndexCol = rFind2.Column
wsMain.Cells(rng.Row + 1, LastColumn).Resize(LR - 2).Formula = "=VLOOKUP(A" & rng.Row + 1 & ",'Connect Report'!$A:$AL," & IndexCol & ",FALSE)"
wsMain.Cells(rng.Row + 1, LastColumn2).Resize(LR - 2).Formula = "=IF(OR(OR(RC[-2]="""",RC[-1]="""",RC[-1]=""x"",)),"""",RC[-1]-RC[-2])"
Else
MsgBox "Excel could not find " & LookupHeaders(i) & " in the lookup table."
End If
Set rng2 = rFind1.Offset(1).Resize(, 8)
pricecol2 = Application.Match("New Muted Price", rng, 0)
LastColumn3 = rFind1.Column + pricecol2
If wsMain.Cells(rng.Row, LastColumn3) <> "New Muted Price" Then
wsMain.Columns(LastColumn3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng2.Row, LastColumn3).Value = "New Muted Price"
wsMain.Cells(rng2.Row, LastColumn3).Interior.ColorIndex = 22
LastColumn4 = LastColumn3 + 1
wsMain.Columns(LastColumn4).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng2.Row, LastColumn4).Value = "Difference"
wsMain.Cells(rng2.Row, LastColumn4).Interior.ColorIndex = 22
End If
Set rFind3 = wsLookup.Rows(1).Find(LookupHeaders2(i), wsLookup.Range("A1"), xlValues, xlWhole)
If Not rFind3 Is Nothing Then
IndexCol = rFind3.Column
wsMain.Cells(rng2.Row + 1, LastColumn3).Resize(LR - 2).Formula = "=VLOOKUP(A" & rng2.Row + 1 & ",'Connect Report'!$A:$AL," & IndexCol & ",FALSE)"
wsMain.Cells(rng2.Row + 1, LastColumn4).Resize(LR - 2).Formula = "=IF(OR(OR(RC[-2]="""",RC[-1]="""",RC[-1]=""x"",)),"""",RC[-1]-RC[-2])"
Else
MsgBox "Excel could not find " & LookupHeaders2(i) & " in the lookup table."
End If
End If
End If
End With
Next i
End Sub
Can anyone help with this? I am completely lost on how to resolve this issue. Also, I am hoping that I described the issue clearly... it is quite confusing.

Answer 1

I believe something like this should work for you. Give it a try and let me know.
Sub tgr()
Dim wb As Workbook
Dim wsMain As Worksheet
Dim wsLookup As Worksheet
Dim rng As Range
Dim rFind1 As Range
Dim rFind2 As Range
Dim MyArray As Variant
Dim LookupHeaders As Variant
Dim LR As Long
Dim i As Long
Dim PriceCol As Long
Dim LastColumn As Long
Set wb = ActiveWorkbook
Set wsMain = wb.ActiveSheet
Set wsLookup = wb.Sheets("ABC") '<-- Change to correct sheet name for the Lookup sheet
LR = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row
MyArray = Array("TEST", "Food", "Non-AlcoholicDrinks", "Appetizers", "Alcoholic Drinks")
LookupHeaders = Array("TestHeader", "FoodHeader", "Non-AlcoholicDrinksHeader", "AppetizersHeader", "Alcoholic DrinksHeader")
For i = LBound(MyArray) To UBound(MyArray)
Set rFind1 = wsMain.Rows(1).Find(What:=MyArray(i), LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind1 Is Nothing Then
Set rng = rFind1.Offset(1).Resize(, 8)
PriceCol = Application.Match("Price", rng, 0)
LastColumn = rFind1.Column + PriceCol
If wsMain.Cells(rng.Row, LastColumn) <> "Difference" Then
wsMain.Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
wsMain.Cells(rng.Row, LastColumn).Value = "Difference"
wsMain.Cells(rng.Row, LastColumn).Interior.ColorIndex = 22
End If
Set rFind2 = wsLookup.Rows(1).Find(LookupHeaders(i), wsLookup.Range("A1"), xlValues, xlPart)
If Not rFind2 Is Nothing Then
With wsMain.Cells(rng.Row + 1, LastColumn).Resize(LR - 2)
.Formula = "=VLOOKUP(A" & rng.Row + 1 & "," & wsLookup.Range("A:AL").Address(External:=True) & "," & rFind2.Column & ",FALSE)"
.Value = .Value 'Convert to values
End With
End If
End If
Next i
End Sub

Answer 2

This is a User Defined Function I've wrote to find the range of based on column header, it uses .find method to find the target cells. Works well if you column titles are are the top of your worksheet.
I hope this solves your problem, you could just findout the target column, by using .column on the range returned.
'define a range by looking for a specific text title, and return all the cells to the lastrow of the sheet as a range
Private Function defineColRange(ByVal targetWorkSheet As Worksheet, ByVal targetValue As String, _
Optional ByVal visibleOnly As Boolean, Optional ByVal rtnNoTitle As Boolean, _
Optional ByVal searchByColumn, Optional ByVal searchBackwards) As Range
Dim targetlastRow As Long
Dim targetlastCol As Long
Dim returnRange As Range
Dim findTarget As Range
'default visible only mode off
If IsMissing(visibleOnly) Then
visibleOnly = False
End If
If IsMissing(rtnNoTitle) Then 'Don't return title cell in the range returned
rtnNoTitle = False
End If
If IsMissing(searchByColumn) Then 'Search vertically by column, instead of by rows
searchByColumn = False
End If
If IsMissing(searchBackwards) Then 'Search backwards by rows
searchBackwards = False
End If
'test if targetWorkSheet is not empty
If targetWorkSheet Is Nothing Then
MsgBox ("Worksheet pass failed!"), vbExclamation
Exit Function
End If
targetWorkSheet.Activate
targetlastRow = targetWorkSheet.UsedRange.Find(What:="*", _
after:=Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
Searchorder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
targetlastCol = targetWorkSheet.UsedRange.Find(What:="*", _
after:=Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
Searchorder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
'find the range
If searchByColumn = True Then
Set findTarget = targetWorkSheet.UsedRange.Find(What:=targetValue, after:=Cells(1, 1), _
LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
ElseIf searchBackwards = True Then
Set findTarget = targetWorkSheet.UsedRange.Find(What:=targetValue, after:=Cells(1, targetlastCol), _
LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False)
Else
Set findTarget = targetWorkSheet.UsedRange.Find(What:=targetValue, after:=Cells(1, 1), _
LookIn:=xlFormulas, Lookat:=xlPart, Searchorder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
End If
If findTarget Is Nothing Then
Debug.Print ("Did not find columne title """ & targetValue & ""), vbExclamation
Exit Function
Else
Dim tRow, tCol As Long
tRow = findTarget.Row
tCol = findTarget.Column
On Error Resume Next
If visibleOnly = False Then
If rtnNoTitle = False Then
Set returnRange = targetWorkSheet.Range(Cells(tRow, tCol), Cells(targetlastRow, tCol))
Set defineColRange = returnRange
Else
Set returnRange = targetWorkSheet.Range(Cells(tRow + 1, tCol), Cells(targetlastRow, tCol))
Set defineColRange = returnRange
End If
Else
If rtnNoTitle = False Then
Set returnRange = targetWorkSheet.Range(Cells(tRow, tCol), Cells(targetlastRow, tCol)).SpecialCells(xlCellTypeVisible)
Set defineColRange = returnRange
Else
Set returnRange = targetWorkSheet.Range(Cells(tRow + 1, tCol), Cells(targetlastRow, tCol)).SpecialCells(xlCellTypeVisible)
Set defineColRange = returnRange
End If
End If
If Err <> 0 Then
Debug.Print "Worksheet: " & targetWorkSheet.Name & " Column Name: " & targetValue
End If
On Error GoTo 0
Err.Clear
End If
End Function