VBA - Rename column header of results column when doing a lookup

[floggingmolly]

I have a VBA code that does a lookup on another sheet and returns the results in a new column named Results, Results 1, Results 2, etc. I am trying to adjust the code so it returns the header for the column that was selected for the lookup. The column name is placed in cell C4 of the Lookup Data sheet so when the code runs and creates a new column (Results, Results 1, etc) if it could name it whatever is in C4 instead of naming it Results is what I would like to accomplish. Any suggestions?

Sub CustomMultipleXLookupsWithDynamicResultColumns()
    Dim mainDataWS As Worksheet
    Dim lookupDataWS As Worksheet
    Dim mainDataTbl As ListObject
    Dim lookupTbl As ListObject
    Dim mainDataCell As Range
    Dim lookupResult As Variant
    Dim lookupColumn As String
    Dim returnColumn As String
    Dim resultColumn As ListColumn
    Dim resultCounter As Long
    
    ' Set references to the worksheets and tables
    Set mainDataWS = ThisWorkbook.Worksheets("Main Data")
    Set lookupDataWS = ThisWorkbook.Worksheets("Lookup Data")
    Set mainDataTbl = mainDataWS.ListObjects("MainData")
    Set lookupTbl = lookupDataWS.ListObjects("LookupData")
    
    ' Get the lookup column name from cell C2 on the "Main Data" sheet
    lookupColumn = CStr(mainDataWS.Range("A4").Value) ' Convert to a string
    
    ' Get the return column name from cell C2 on the "Lookup Data" sheet
    returnColumn = CStr(lookupDataWS.Range("A4").Value) ' Convert to a string
    
    ' Check if a result column with the same name already exists
    On Error Resume Next
    Set resultColumn = mainDataTbl.ListColumns("Results")
    On Error GoTo 0
    
    If Not resultColumn Is Nothing Then
        ' Increment the result counter
        resultCounter = resultCounter + 1
        newResultColumnName = "Results " & resultCounter
    Else
        newResultColumnName = "Results"
    End If
    
    ' Add a new column to the MainData table to store the lookup results
    mainDataTbl.ListColumns.Add
    Set resultColumn = mainDataTbl.ListColumns(mainDataTbl.ListColumns.Count)
    resultColumn.Name = newResultColumnName
    
    ' Loop through each row in the MainData table
    For Each mainDataCell In mainDataTbl.ListColumns(lookupColumn).DataBodyRange
        ' Perform the lookup using INDEX and MATCH
        On Error Resume Next
        lookupResult = Application.WorksheetFunction.Index(lookupTbl.ListColumns(returnColumn).DataBodyRange, Application.WorksheetFunction.Match(mainDataCell.Value, lookupTbl.ListColumns(lookupColumn).DataBodyRange, 0))
        On Error GoTo 0
        
        ' Check if an error occurred (no match found)
        If IsError(lookupResult) Then
            lookupResult = ""
        End If
        
        ' Write the lookup result to the new result column
        mainDataCell.Offset(0, resultColumn.Index - mainDataTbl.ListColumns(lookupColumn).Index).Value = lookupResult
    Next mainDataCell
    
    Worksheets("Main Data").Activate
End Sub

 

[NateSC]

So to grab the name you would add somewhere around line 24:

    Dim returnHeader as String
    returnHeader = CStr(lookupDataWS.Range("C4").Value) ' Convert to a string

Then to put it at the top of the added column you would change the following IF statement (currently line 30-36, but you only need to change the 2 lines pointed out below) :

   If Not resultColumn Is Nothing Then
        ' Increment the result counter
        resultCounter = resultCounter + 1
        newResultColumnName = returnHeader & " " & resultCounter  '!!! UPDATED LINE !!!
    Else
        newResultColumnName = returnHeader      '!!! UPDATED LINE !!!
    End If

 

[floggingmolly]

So to grab the name you would add somewhere around line 24:

    Dim returnHeader as String
    returnHeader = CStr(lookupDataWS.Range("C4").Value) ' Convert to a string

Then to put it at the top of the added column you would change the following IF statement (currently line 30-36, but you only need to change the 2 lines pointed out below) :

   If Not resultColumn Is Nothing Then
        ' Increment the result counter
        resultCounter = resultCounter + 1
        newResultColumnName = returnHeader & " " & resultCounter  '!!! UPDATED LINE !!!
    Else
        newResultColumnName = returnHeader      '!!! UPDATED LINE !!!
    End If

Awesome. Thank you so much for the help. Much appreciated.