VBA VLookup by Column Name

Match instead of VLookup

You could use the following function to get the column number:

Function getTableColumnNumber( _
    ByVal HeaderRange As Range, _
    ByVal HeaderTitle As String) _
As Long
    If Not HeaderRange Is Nothing Then
        If Len(HeaderTitle) > 0 Then
            Dim cIndex As Variant
            cIndex = Application.Match(HeaderTitle, HeaderRange, 0)
            If IsNumeric(cIndex) Then
                getTableColumnNumber = cIndex
            End If
        End If
    End If
End Function

Note that the column number is the 'n-th' column of the header range which is not necessarily the 'n-th' column of the worksheet (e.g. if the range starts in column C).

An Example

• On the left is the Source Worksheet (Sheet1) which usually contains unique data (green column).
• On the right is the Destination Worksheet (Sheet2) where the yellow column is initially blank. It illustrates a case where VLookup cannot work because the return values (yellow column) are to the left of the lookup values (green column).

• This is a case where all the columns are defined by their headers.
• Adjust the values in the constants section.
• s - Source, d - Destination, l - Lookup, m - Match.

Option Explicit

Sub matchValues()

    Const sName As String = "Sheet1"
    Const slHeader As String = "ID"
    Const smHeader As String = "Value"
    Const sCols As String = "A:Z"
    Const sFirst As Long = 1
    
    Const dName As String = "Sheet2"
    Const dlHeader As String = "ID"
    Const dmHeader As String = "Value"
    Const dCols As String = "A:Z"
    Const dFirst As String = 1

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim slrg As Range, smrg As Range
    With wb.Worksheets(sName)
        Dim shrg As Range: Set shrg = .Columns(sCols).Rows(sFirst)
        Dim slCol As Long: slCol = getTableColumnNumber(shrg, slHeader)
        If slCol = 0 Then Exit Sub
        Dim smCol As Long: smCol = getTableColumnNumber(shrg, smHeader)
        If smCol = 0 Then Exit Sub
        Dim srg As Range: Set srg = getDataRange(shrg)
        Set slrg = srg.Columns(slCol)
        Set smrg = srg.Columns(smCol)
    End With
    
    Dim drg As Range
    With wb.Worksheets(dName)
        Dim dhrg As Range: Set dhrg = .Columns(dCols).Rows(dFirst)
        Dim dlCol As Long: dlCol = getTableColumnNumber(dhrg, dlHeader)
        If dlCol = 0 Then Exit Sub
        Dim dmCol As Long: dmCol = getTableColumnNumber(dhrg, dmHeader)
        If dmCol = 0 Then Exit Sub
        Set drg = getDataRange(dhrg)
    End With
    
    Dim dCell As Range
    Dim cIndex As Variant
    For Each dCell In drg.Columns(dlCol).Cells
        cIndex = Application.Match(dCell.Value, slrg, 0)
        If IsNumeric(cIndex) Then
            dCell.EntireRow.Columns(dmCol).Value = smrg.Cells(cIndex).Value
        Else
            dCell.EntireRow.Columns(dmCol).Value = "Not Found"
        End If
    Next dCell

End Sub

Function getTableColumnNumber( _
    ByVal HeaderRange As Range, _
    ByVal HeaderTitle As String) _
As Long
    If Not HeaderRange Is Nothing Then
        If Len(HeaderTitle) > 0 Then
            Dim cIndex As Variant
            cIndex = Application.Match(HeaderTitle, HeaderRange, 0)
            If IsNumeric(cIndex) Then
                getTableColumnNumber = cIndex
            End If
        End If
    End If
End Function

Function getDataRange( _
    ByVal HeaderRange As Range) _
As Range
    If Not HeaderRange Is Nothing Then
        With HeaderRange.Offset(1)
            Dim lCell As Range
            Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
                .Find("*", , xlFormulas, , xlByRows, xlPrevious)
            If Not lCell Is Nothing Then
                Set getDataRange = .Resize(lCell.Row - .Row + 1)
            End If
        End With
    End If
End Function