VBA code to Pull data from multiple sheet into a master sheet based on Column name

Question

Hello Guys,

I really need your help on this as I had googled few code but it doesn't seems to be working. Suppose I have Sheet 1 & Sheet 2 were data from multiple systems are pasted wherein few column names are same but not in the same order.

Example:

Sheet 1 data header: Database      Name                 Organisation        Date             Amount

Sheet 2 data header: Database      Company           Name                   Amount        Date

Macro to pull values from each sheet based on the column header mentioned in Sheet 3

Sheet 3 data header:    Database   Name    Date   Amount

Required:

•I want a VBA code which pulls out the data from Sheet 1 &2 into Sheet 3 based on the column header specified in Sheet 3

• Secondly, if any new column header is added in Sheet 3 then the macro should pull that data as well

• Thirdly, it should bypass/skip if data in not present in any one of the sheet present.

Kindly assist me.

Thanks

Answer 1

The code example below loops through all worksheets. Best to have the worksheets to be skipped in a worksheet and then the user does not need to be able to edit the VBA code to add sheets to be skipped. Therefore add a worksheet called "Exclude List" and insert the list of worksheets to be excluded in column A as per the screen snippet. The name of the column header is really irrelevant.

I am not sure if you want to clear the Main data sheet prior to copying the data from the source sheets so I have included a line to do this and you will find it between two asterisk lines so if you don't want to clear the data first then just comment out the line (or delete it).

If you use a different name than "Main data" for the output sheet then edit the VBA code accordingly where I have made the comment. Similarly, if you use a different name for the Exclude list and ensure that both these sheets are included in the Exclude list as above screen snippet.

Note that there is the main sub to run plus a UDF (User Defined Function) in the code. The UDF is used to find the next unused row on the output worksheet.

Feel free to get back to me if any problems.

Sub CopyFromMultiShts()

    Dim wsMain As Worksheet

    Dim wsExclude As Worksheet

    Dim rngColHeaders As Range

    Dim ws As Worksheet

    Dim lngNextRow As Long

    Dim cel As Range

    Dim rngToFind As Range

    Dim rngDestin As Range

    Dim rngToCopy As Range

    Set wsMain = Worksheets("Main data")     'Edit "Main data" to your output worksheet name

    Set wsExclude = Worksheets("Exclude List")  'Edit "Exclude List" to worksheet with list of worksheets to exclude

    With wsMain

        'Assign Column Headers of Main data sheet to a range variable

        Set rngColHeaders = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))

        '**************************************************************************************

        .Rows(2 & ":" & .Rows.Count).ClearContents    'Optional to clear existing data first.

        '**************************************************************************************

    End With

    For Each ws In Worksheets   'Loop through worksheets

        If WorksheetFunction.CountIf(wsExclude.Columns("A:A"), ws.Name) = 0 Then    'Equal zero then not in exclude list

            lngNextRow = LastRowOrCol(True, wsMain.Cells) + 1 'Next blank row in Main data worksheet

            With ws

                'Assign column headers of source worksheet to a range variable

                Set rngColHeaders = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))

                For Each cel In rngColHeaders   'Loop through column headers in source worksheet

                    If WorksheetFunction.CountA(cel.EntireColumn) > 1 Then   'If more than column header data exists

                        With wsMain   'Start of nested With/End With

                            'Search for column header in Main data worksheet

                            Set rngToFind = .Rows(1).Find(What:=cel.Value, _

                                            LookIn:=xlFormulas, _

                                            LookAt:=xlWhole, _

                                            SearchOrder:=xlByRows, _

                                            SearchDirection:=xlNext, _

                                            MatchCase:=False)

                            If rngToFind Is Nothing Then GoTo SkipCopy  'If Nothing then column header not found so skip copy

                            'Next blank row in Main data (lngNextRow from above) and column where column header found

                            Set rngDestin = .Cells(lngNextRow, rngToFind.Column)

                        End With        'End nested With/End With

                        'Assign data from source worksheet to a range variable (From cell below column header to bottom of data)

                        Set rngToCopy = .Range(cel.Offset(1, 0), .Cells(.Rows.Count, cel.Column).End(xlUp))

                        'Copy column from source worksheet to Main data worksheet

                        rngToCopy.Copy Destination:=rngDestin

                    End If

SkipCopy:

                Next cel

            End With

        End If

    Next ws

    wsMain.Columns.AutoFit    'Optional code

End Sub

Function LastRowOrCol(bolRowOrCol As Boolean, Optional rng As Range) As Long

    'Finds the last used row or column in a worksheet

    'First parameter is True for Last Row or False for last Column

    'Third parameter is optional

        'Must be specified if not ActiveSheet

    Dim lngRowCol As Long

    Dim rngToFind As Range

    If rng Is Nothing Then

        Set rng = ActiveSheet.Cells

    End If

    If bolRowOrCol Then

        lngRowCol = xlByRows

    Else

        lngRowCol = xlByColumns

    End If

    With rng

        Set rngToFind = rng.Find(What:="*", _

                LookIn:=xlFormulas, _

                LookAt:=xlPart, _

                SearchOrder:=lngRowCol, _

                SearchDirection:=xlPrevious, _

                MatchCase:=False)

    End With

    If Not rngToFind Is Nothing Then

        If bolRowOrCol Then

            LastRowOrCol = rngToFind.Row

        Else

            LastRowOrCol = rngToFind.Column

        End If

    End If

End Function

Answer 2

Many thanks, will get back to you in case of any error or doubt but really it provides a very nice explanation which will surely help to adjust my needs at any given point of time.

Answer 3

Hello OssieMac,

Thanks for looking into my question. 

1. For the first point, i mean to say that if at any given point if in Sheet 3 (where all data is fetched) user adds a new header "Organization name" which is not available under sheet1 but is available under sheet2 then macro should look for the data prevailing sheets and fetch the data. In more simpler language I want to say that  sheet3 or just name the sheet as "Main data" should fetch data from all the prevailing sheets in that particular workbook as per the column header which is dynamic.
2. Yes, you are correct. The data should be appended.
3. Yes, Sh1 & Sh2 were just for example, I want macro to loop through all sheets except the destination sheet ("Main data) and it would be great if you can just add a line where I can insert any sheet or its name which needs to be skipped in future.

Answer 4

I have had a look at this for you and have commenced writing the code but I am wondering if the following statement is really what you meant. "Secondly, if any new column header is added in Sheet3 then the macro should pull that data as well"

Is the above what you meant or did you mean if there is an extra column in Sheet1 or Sheet2 that is not currently in Sheet3 then you need that data also to be copied to Sheet3?

When the data is copied, will Sheet3 be cleared of all existing data first or will it be appended to existing data? (I assume that sheet2 data will be appended to the bottom sheet1data).

Is Sheet1 and Sheet2 simply examples and there could be more than 2 sheets from which to get the data. If the number of sheets is unknown, can we simply loop through all sheets, except the destination sheet, and collect data from all or are there also other sheets besides the destination sheet that need to be skipped?