CODEWITHSUNDEEP
excelvba
maed
maed

Reputation: 1

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

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

Upvotes: 0

Views: 739

Answers (2)

Tim Williams
Tim Williams

Reputation: 166595

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

Upvotes: 0

maed
maed

Reputation: 1

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

Upvotes: 0

Related Questions