Search for multiple column headers written in the master sheet on row 1 FROM other sheets to copy entire columns over

0
votes

In the MasterSheet say I have column headers "Employee Names", "CarType" and "DOB". These columns and their row data are found in different sheets in the same workbook. I need a simple lookup function in VBA to search for multiple column headers and COPY over the entire column. I need multiple columns in the master file to be filled in like this so a loop function is needed.

If a heading is not found leave the row blank and move on to the column header on the MasterSheet.

Thank you in advance! My first post and so I don't know if the explanation above helps.

Sample MasterSheet Sheet2 where one column head is

The below basic code is what I found but it's too basic and doesn't loop through Macro VBA to Copy Column based on Header and Paste into another Sheet

2
excelvba
SO is not a code-writing service... You should be able to use Find() or Match() to make a start on this - post back with code if you run into problems. – Tim Williams
Excel's Find and Match functions work only if you know what sheet to look for and you can reference those sheets. It doesn't run a blank search across multiple sheets in a workbook. I have meta data in different sheets but the column headers are always constant but hidden among many columns across multiple sheets. Thank you. – maed
So you'd need to write some code to loop over the sheets in your workbook - there are lots of examples of that here on SO alone. – Tim Williams
@TimWilliams that's correct but I don't know how to run a loop to just look at column headers from the MasterSheet. Right now I'm going to each sheet and finding my column header manually. Please take a look at the code I posted below as an answer – maed

2 Answers

0
votes

This is what I have so far but the limitations are that it looks at one sheet at a time and the header search is not dynamic.

Sub MasterSheet()

Dim newSht As Worksheet, sSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As 
Range
Set sSht = ActiveSheet
'Expand the array below to include all relevant column headers - I want the below 
line to be dynamic. Looking at multiple headers from the MasterSheet.
Hdrs = Array("Heading 1")
Application.ScreenUpdating = False
Set newSht = Worksheets.Add(after:=sSht)
With sSht.UsedRange.Rows(1)
    For i = LBound(Hdrs) To UBound(Hdrs)
        Set EdrisRange = .Find(Hdrs(i), lookat:=xlWhole)
        If Not EdrisRange Is Nothing Then
            Intersect(EdrisRange.EntireColumn, sSht.UsedRange).Copy 
Destination:=newSht.Cells(1, i + 1)
        End If
    Next i
    Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
End Sub
0
votes

Something like this should work:

Sub MasterSheet()

    Dim wb As Workbook
    Dim newSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As Range

    Hdrs = Array("Heading 1", "Heading 2")

    Set wb = ActiveWorkbook

    Set newSht = wb.Worksheets.Add(after:=ActiveSheet)

    For i = LBound(Hdrs) To UBound(Hdrs)
        Set EdrisRange = FindHeaderInWorkbook(wb, CStr(Hdrs(i)), newSht)
        If Not EdrisRange Is Nothing Then
            Application.Intersect(EdrisRange.EntireColumn, EdrisRange.Parent.UsedRange).Copy _
                                                         Destination:=newSht.Cells(1, i + 1)
        End If
    Next i

    Application.CutCopyMode = False

End Sub

'find a header *HeaderText* in a workbook *wb*, excluding the sheet *excludeSheet*
Function FindHeaderInWorkbook(wb As Workbook, HeaderText As String, excludeSheet As Worksheet)
    Dim sht As Worksheet, rng As Range
    For Each sht In wb.Worksheets
        If sht.Name <> excludeSheet.Name Then
            Set rng = sht.Rows(1).Find(what:=HeaderText, lookat:=xlWhole)
            If Not rng Is Nothing Then Exit For
        End If
    Next sht
    Set FindHeaderInWorkbook = rng
End Function