Excel VBA that searches by header name not column - vba

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.
"Number Stored as Text" error
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