vLookup Generation

[thumbguy]

Hello,

I am trying to create a macro to copy/paste a generated vLookup formula using a user selected range ("Reference Data") and with the following criteria:

- The table array starting column needs to increment by 1 until it reaches the 2nd to last column of the user selected range, but the ending column needs to remain locked
- The formula should be copied left to right while decrementing the Column_index (starting with the first column of the user selected range ending with the 2nd to last column of the user selected range). This is so that the Column_index is looking at the same column of the reference data
- This should repeat for each row in the "XYR Data" Table

To do this manually, I first write the vLookup as

=VLOOKUP(D2,I2:L6,4,FALSE)

and then lock rows and columns to get

=VLOOKUP(D$2,I$2:$L$6,4,FALSE)

This is then flash filled across however many columns are in the reference data less one.
I then go through each filled cell and decrement the Col_Index_Num by 1 until it gets down to 2.
This entire row is then flash filled down for each row of the "XYR Data" table.

I've gotten the code this far. It asks or the reference range and target cell, and generates a vlookup based off of that. But the copy paste is happening in reverse order to what I need and I havent been able to figure out how to lock certain Row/Column references in the formula.

Sub GenerateVLOOKUPAndCopy()
    Dim SourceRange As Range
    Dim NewRange As Range
    Dim TargetCell As Range
    Dim FormulaString As String
    Dim ColumnIndex As Integer
    Dim LookupValueColumn As Integer
    
    ' Check if a range is selected
    On Error Resume Next
    Set SourceRange = Application.InputBox("Select the BOM range:", Type:=8)
    On Error GoTo 0
    
    If SourceRange Is Nothing Then
        MsgBox "No BOM selected. Exiting the macro."
        Exit Sub
    End If
    
    ' InputBox for the target cell where the VLOOKUP formula will be pasted
    On Error Resume Next
    Set TargetCell = Application.InputBox("Select the target cell where the VLOOKUP formula should be pasted:", Type:=8)
    On Error GoTo 0
    
    If TargetCell Is Nothing Then
        MsgBox "No target cell selected. Exiting the macro."
        Exit Sub
    End If
    
    ' Initialize column index and lookup value column
    ColumnIndex = SourceRange.columns.Count
    LookupValueColumn = 1

    
    ' Loop to generate and copy VLOOKUP formulas
    Do While ColumnIndex >= 2
        ' Generate the VLOOKUP formula
        FormulaString = "=VLOOKUP(" & TargetCell.Offset(0, -1).Address & "," & _
                        SourceRange.Address(True, False) & "," & _
                        ColumnIndex & "," & _
                        False & ")"
        
        ' Paste the formula in the target cell
        TargetCell.Offset(0, ColumnIndex - 2).Formula = FormulaString
        
        ' Decrement the column index and increment the lookup value column
        ColumnIndex = ColumnIndex - 1
        LookupValueColumn = LookupValueColumn + 1
    Loop
End Sub

This is ideally how the final table of formulas would look and how the lookup range would move with each step

And what the final Results would show

The final cleanup of deleting the #N/A cells and getting the results in column E is done in a separate macro that already works.

Some final information:
The XYR is always in that format, with the first lookup value in cell D2 and the final results ultimately being in column E.
The reference data is a variable number of columns wide but the Index Column is always the very last one.

Any help would be appreciated!

 

[kevin9999]

If you're open to a different approach, this is how I would do this:

Option Explicit
Option Compare Text
Sub thumbguy()
    Dim a, b, c
    Dim i As Long, j As Long, k As Long, m As Long, LCol As Long
    LCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
    a = Range("D2", Cells(Rows.Count, "D").End(xlUp))
    b = Range("I2", Cells(Rows.Count, LCol).End(xlUp))
    m = LCol - 8
    ReDim c(1 To UBound(a, 1), 1 To m - 1)
    
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(b, 1)
            For k = 1 To m - 1
                If a(i, 1) = b(j, k) Then c(i, k) = b(j, m): Exit For
            Next k
        Next j
    Next i
    Range("E2").Resize(UBound(c, 1), m - 1).Value = c
End Sub

Before:

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1		XYR Data				Results						Reference data
2	2219	3918	1621	D					A			C102
3	6472	4690	5197	A						B	C	C105
4	253	1610	3731	B					D	E	F	R102
5	5254	4665	3791	H							G	R2R6
6	1876	253	3685	G						H		C1005
Sheet1

After:

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1		XYR Data				Results						Reference data
2	2219	3918	1621	D	R102				A			C102
3	6472	4690	5197	A	C102					B	C	C105
4	253	1610	3731	B		C105			D	E	F	R102
5	5254	4665	3791	H		C1005					G	R2R6
6	1876	253	3685	G			R2R6			H		C1005
Sheet1

 

[kevin9999]

The reference data is a variable number of columns wide but the Index Column is always the very last one.

That being the case, the Results table would also be extended to the right, and therefore the first column of the Results data would also shift to the right. As such, the following code would be safer:

Option Explicit
Option Compare Text
Sub thumbguy_V2()
    Dim a, b, c
    Dim i As Long, j As Long, k As Long, m As Long
    Dim LCol As Long, StartRef As Long, LRow As Long
    LCol = Cells(1, Columns.Count).End(xlToLeft).Column
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    
    For i = 8 To LCol
        If Application.CountA(Columns(i)) > 0 Then StartRef = i: Exit For
    Next i
    
    a = Range("D2", Cells(Rows.Count, "D").End(xlUp))
    b = Range(Cells(2, StartRef), Cells(Rows.Count, LCol).End(xlUp))
    m = LCol - (StartRef - 1)
    ReDim c(1 To UBound(a, 1), 1 To m - 1)
    
    For i = 1 To UBound(a, 1)
        For j = 1 To UBound(b, 1)
            For k = 1 To m - 1
                If a(i, 1) = b(j, k) Then c(i, k) = b(j, m): Exit For
            Next k
        Next j
    Next i
    Range("E2").Resize(UBound(c, 1), m - 1).Value = c
End Sub

 

[StephenCrump]

@thumbguy, welcome to the Forum!

The final cleanup of deleting the #N/A cells and getting the results in column E is done in a separate macro that already works.

If the required end result is all in Column E, then couldn't you use the simple formula?

E2: =CONCAT(IF(D2=I$2:K$6,L$2:L$6,""))