Excel VBA that searches by header name not column

Question

I need a VBA macro that does the below:

This part works fine, I want it to make a new column on sheet1 and name it header name then color it.

Columns("P:P").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("P1").Select
ActiveCell.FormulaR1C1 = "Header Name"
Range("P1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 15773696
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

This part however I would like to look for the header name on sheet2 not just the column C (since sometimes the column locations can change)

Range("P2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],Sheet2!C[-15]:C[-14],2,FALSE)"
Range("P2").Select
Selection.AutoFill Destination:=Range("P2:P" & Cells(Rows.Count, "X").End(xlUp).Row)

so basically this is what I want it to do:

on sheet 1 make a new column in P and name it "header name" then I want it to do a vlook up for column x (header 2) on sheet 1 (by name if able) and compare it to sheet2 column a (header 02) and give me the matching information in column B (header 3)

I have used this vlookup =VLOOKUP(X2,Sheet2!A:B,2,FALSE) but I want them to be header names not x,a,b and to search the entire sheet to find the header names.

• Column X name: Header 2
• Column A name: Header 02
• Column B name: Header 3
• Column P name: Header Name

Answer 1

Hmm, somehow feels hard to give this away, this is my precious baby for doing the job. But all I can do is thank stack overflow and all of the community for all they have done, so here goes:

NOTE! I use Dictionaries. To make Dictionaries work, in VBA editor goto Tools > References. In the pop up scroll down to "Microsoft Scripting Runtime" and check the box and click OK.

Option Base 1

Sub TransferData()

    Dim Data()         As Variant
    Dim dataSheet      As String
    Dim resultSheet   As String
    Dim headingIndexes As New Dictionary

    dataSheet = "Data"
    dataStartCell = "A1"
    resultSheet = "Result"
    Data() = Sheets(dataSheet).Range(dataStartCell).CurrentRegion.Value

    Call GetHeadingIndexes(Data(), headingIndexes)
    Call Transfer(Data(), headingIndexes, resultSheet)

End Sub

Sub GetHeadingIndexes(ByRef Data() As Variant, ByRef headingIndexes As Dictionary)

    'Creates a dictionary with key-value pairs
    '
    'Creates a dictionary structure with key-value pairs resembling a table:
    '             [Column Heading] | [Column Index]
    '            "Actual/Forecast" | 1
    '                      "Brand" | 2
    ' "Division/ Line of Business" | 3
    '
    'Now it is easy and quick to find the column index based on column heading.

    Dim i As Integer

    For i = 1 To UBound(Data(), 2)                    
        headingIndexes.Add Data(1, i), i     'Make key-value pairs out of column heading and column index
    Next i

End Sub

Sub Transfer(ByRef Data() As Variant, ByRef headingIndexes As Dictionary, resultSheet As String)

    Application.ScreenUpdating = False

    Dim resultColumnHeading As String
    Dim resultSheetColumnNumber As Integer
    Dim dataColumnNumber As Integer
    Dim row As Integer

    'Loop through columns in result sheet. Assumes you have 16 columns
    For resultSheetColumnNumber = 1 To 16

        'Find the correct column in Data()
        resultColumnHeading = resultSheet.Cells(1, resultSheetColumnNumber)
        dataColumnNumber = headingIndexes(resultColumnHeading)

        For row = 2 To UBound(Data(), 1)

            'Transfer data from Data() array to the cell in resultSheet
            'Note, referencing each cell like this is really slow, it is better to create a resultArray similar to the data array (called Data() in this example). However, explaining all the nuances would take a one hour phone call, and gets far from the question at hand)
            resultSheet.Cells(row, resultSheetColumnNumber) = Data(row, dataColumnNumber)

        Next row

    Next resultSheetColumnNumber

    Application.ScreenUpdating = True

End Sub

Answer 2

It might work if you change this:

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[8],Sheet2!C[-15]:C[-14],2,FALSE)"

to:

ActiveCell.Formula = "=vlookup(X" & ActiveCell.row & ",Sheet2!A:B,2,0)"

But that being said, be careful with ActiveCell and .Select. You may want to check out How to Avoid Using Select in VBA Macros

EDIT: I've amended/added to the code to take into consideration your need for flexibility with regards to where the columns of data are located.

Sub test3()
    'use the Header2sheet1column variable to hold the column number that "Header 2" is found in on sheet 1
    Dim Header2sheet1column As Long
        'search for "Header 2" across row 1 of sheet1 and remember the column number
        Header2sheet1column = Application.Match("Header 2", ThisWorkbook.Sheets("Sheet1").Range("$1:$1"), 0)
    'use the Header2sheet2column variable to hold the column number that "Header 2" is found in on sheet 2
    Dim Header2sheet2column As Long
        'search for "Header 2" across row 1 of sheet2 and remember the column number
        Header2sheet2column = Application.Match("Header 2", ThisWorkbook.Sheets("Sheet2").Range("$1:$1"), 0)
    'use the lookuprange variable to hold the range on sheet2 that will be used in the vlookup formula
    Dim lookuprange As Range

    'using With just so I don't have to type ThisWorkbook.Sheets("Sheet2") a bajillion times in the next couple lines
    With ThisWorkbook.Sheets("Sheet2")
        'set lookuprange variable - will start at column that "Header 2" is found on sheet 2 and will go to last row/column of the sheet
        'having extra columns at the end of your vlookup formula isn't going to hurt. the
        Set lookuprange = .Range(.Cells(1, Header2sheet2column), .Cells(.Rows.Count, .Columns.Count))
        'put formula into Cell P2 on sheet1
        ThisWorkbook.Sheets("Sheet1").Range("P2").Formula = "=vlookup(" & ThisWorkbook.Sheets("Sheet1").Cells(2, Header2sheet1column).Address(RowAbsolute:=False) & ",Sheet2!" _
                                                         & lookuprange.Address & "," _
                                                        & Header2sheet2column & ",0)"
    End With

    'using With again just so I don't have to type ThisWorkbook.Sheets("Sheet1") a bajillion times in the next couple lines
    With ThisWorkbook.Sheets("Sheet1")
    'fill formula in column P down to the row that the column
        .Range("P2").AutoFill Destination:=.Range("P2:P" & .Cells(.Rows.Count, Header2sheet1column).End(xlUp).Row)
    End With

End Sub

Answer 3

You'd be better off using named ranges that are created using the headers for each column. Then your vlookup could just refer to the names rather than the cell references.

To get an idea how to do this start recording a macro then choose your columns and Insert - Names - Create. You can adapt the macro to recreate the names every time your spreadsheet changes. The vlookups won't need to be changed because they will point to the named ranges wherever they are.

Answer 4

I'm far from a VBA expert. Two things in VBA plagued me for a long time until recently.

1. "Number Stored as Text" error
2. Find column by first row 'Name' not 'Column Letter'

I use this in a macro to copy & reorder columns in a new sheet:

    Sub ColumnReorder()
    '**********************************************************
    'Paste this macro into the Workbook of each new "Employee_List_Weekly_Update"
    'Functionality:
    '1. Column order in the "Employee_List_Weekly_Update" worksheet changes fairly often. 
    '   The macro will find each column by header name,
    '   select that column and copy it to the new sheet.
    '2. The macro also converts "Employee ID#" to a number,
    '   removing the "Number saved as Text" error.
    '**********************************************************
    'Create new sheet
        Sheets.Add.Name = "Roster_Columns_Reordered"

    'Repeat for each column or range - For each new section change Dim letter
    'Find Column in "Employee_List_Weekly_Update" - Copy it - Paste it in "Roster_Columns_Reordered" - Employee ID#
        Dim a As Integer
        Sheets("Employee_List_Weekly_Update").Select
        Set rngData = Range("A1").CurrentRegion
        a = Application.WorksheetFunction.Match("Employee ID#", Range("A1:BB1"), 0)
        Columns(a).Select
        Selection.Copy

        Sheets("Roster_Columns_Reordered").Select
        Range("A1").Select
        ActiveSheet.Paste
    'Use TextToColumns to convert "Number Stored as Text "
        Selection.TextToColumns _
          Destination:=Range("A:A"), _
          DataType:=xlDelimited

    'Find Column in "Employee_List_Weekly_Update" - Copy it - Paste it in "Roster_Columns_Reordered" - Name
        Dim b As Integer
        Sheets("Employee_List_Weekly_Update").Select
        Set rngData = Range("A1").CurrentRegion
        b = Application.WorksheetFunction.Match("Name", Range("A1:BB1"), 0)
        Columns(b).Select
        Selection.Copy

        Sheets("Roster_Columns_Reordered").Select
        Range("B1").Select
        ActiveSheet.Paste

    'Go to "Roster_Columns_Reordered" - Add AutoFilter - Freeze Top Row
        Rows("1:1").Select
        Selection.AutoFilter
        With ActiveWindow
          .SplitColumn = 2
          .SplitRow = 1
        End With
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        Range("A1").Select

    End Sub