VBA Code Require - Consolidate multiple sheets in 1 sheet when column Headin differs

[Yadavagiri]

Hi Team,

VBA Code required to consolidate multiple sheets into one consolidated sheet when the column heading is different.

Attached sample raw data where I need VBA code consolidate data from all the sheets into one sheet matching with the EIN and data against the column heading from all the sheets.

Kindly let me know for any clarifications.

Regards,
Yadavagiri

[p45cal]

In the linked-to file below, 2 new sheets added:
Consolidated: what it says on the tin: where possible columns merged, where not, just added as new columns.
Pivot: The beginnings of a pivot table of the consolidated sheet.

Power Query has consolidated the sheets. For you to use different data, update the information in the 6 tables, refresh the query called Consolidate (right-click the Consolidated table and choose Refresh) and refresh the pivot table.

That's it.

link to big file:
https://app.box.com/s/60mpxqpwlin82q9bdx8b6ecypb5mwe72

ps. the file size could be reduced by loading the consolidated date to the Data Model rather than the Consolidated sheet which would reduce the file size to less that two thirds.

[p45cal]

I've beeen playing about with Power Query (I don't know what I'm doing) and managed to reduce the file size even more to where it's only 6% bigger than your file, and so can attach it here. You can't see the consolidated data because it doesn't exist on a sheet, but the pivot table connects to it. Now it appears you only need to refresh the pivot table, and it seems to be quicker too.

[mana]

Option Explicit


 Sub test()
    Dim dic As Object
    Dim ws As Worksheet
    Dim v, w()
    Dim j As Long, k As Long
    Dim s As String
    Dim m As Long, n As Long
    
    Set dic = CreateObject("scripting.dictionary")

    ReDim w(1 To Rows.Count, 1 To 100)
    
    For Each ws In Worksheets
        v = ws.Cells(1).CurrentRegion.Value
        For j = 1 To UBound(v, 1)
            s = v(j, 1) & v(j, 2) & v(j, 3) & v(j, 4)
            If Not dic.exists(s) Then
                n = dic.Count + 1
                dic(s) = n
                w(n, 1) = v(j, 1)
                w(n, 2) = v(j, 2)
                w(n, 3) = v(j, 3)
                w(n, 4) = v(j, 4)
            End If
            n = dic(s)
            For k = 5 To UBound(v, 2)
                w(n, k + m) = v(j, k)
            Next
        Next
        m = m + UBound(v, 2) - 4
    Next
        
    With Workbooks.Add(xlWBATWorksheet).Sheets(1).Cells(1)
        .Resize(dic.Count, m - 1).Value = w
        .CurrentRegion.Sort .Columns(3), Header:=xlYes
    End With

 End Sub

マナ

[Yadavagiri]

Hi Mana,

Thanks for VBA Code,when I run the code, I am getting error. Attached error screenshot. please do the needful and let me now what needs to be done.

Regards,
Yadavagiri

[Yadavagiri]

Hi,

I don't have power query enabled in my system as it doesn't support Any possible for getting VBA Code?

Regards,
YadavagirI

[mana]

try this

    'ReDim w(1 To Rows.Count, 1 To 100)


    Dim x As Long, y As Long 


    For Each ws In Worksheets
        x = x + ws.Cells(1).End(xlToRight).Column
        y = y + ws.Cells(1).End(xlDown).Row
    Next
    ReDim w(1 To y, 1 To x)

[Yadavagiri]

Hi Mana,

I am very sorry to come back as im little bad at VBA. Where do I input this code?

Regards,
Yadavagiri

[mana]

Instead of this line.

> ReDim w(1 To Rows.Count, 1 To 100)

[Yadavagiri]

Hi Mana,

I tried replacing, however, got error. Enclosed Screenshot.

I have attached my sample excel file. Please could you help on the same.

Regards,
Yadavagiri

[Yadavagiri]

Hi Mana,

I thank you for assisting which is very much appreciated.

your code with the above changes was success and it worked, however, if I add any additional column data in any of the sheets and also if any new sheets are added in the workbook, it is not working.

please help!

Regards,
Yadavagiri

[mana]

>it is not working

What do you mean?
Error occurs?

[Yadavagiri]

Hi Mana,

Thanks for getting back.

I meant to say that, if I add any additional column, the data is not capturing. Also, if I add any additional sheet, it is not updating.

Attached file, Consolidated Sheet is the sheet which I have worked from your code.

Sheet highlighted in Orange in the attached, where the data has captured only one column (Work) remaining data in column F & G is not captured in the Consolidated Sheet.

Also no data is captured from sheet highlighted in Red (Hold).

Kindly help.

Regards,
Yadavagiri

[mana]

It's not automatic,
you have to run again.

[Yadavagiri]

Hi Mana,

Yes I have ran the code again but its the same as above.

Regards,
Yadavagiri

[mana]

.Resize(dic.Count, m + 4).Value = w

[Yadavagiri]

Hi Mana,

Sorry to revert back so late.
I have amended the changes which is perfectly working fine for my current set of data.

however, I have another set of data where there are multiple column headers and when I update this code and run, it throws out error.

Please help me with a VBA Code where the code will run even though there are multiple column headers.

Regards,
Yadavagiri

[mana]

however, I have another set of data where there are multiple column headers and when I update this code and run, it throws out error.

I need sample data.
Please upload your workbook.

[Yadavagiri]

Hi Mana,

File size is around 4mb and I am unable to upload. Do you have email id so that i can forward you?

Regards,
Yadavagiri

[snb]

@mana

Use advancedfilter.