Merging Worksheets with different headers

[pglove]

Windows 7 x64
Excel 2007

I have scoured the internet for a quick solution to this problem, there are many questions that seem to ask the same thing I require but no answers I can see.

Microsoft knowledge base is useful, but unfortunately I can't seem to find a solution that applies to this particular case. Same with MrExcel, so if there is a thread I've missed that'll make my century!

_____

I have 18 workbooks
Each workbook has up to 22 worksheets
~ 400 worksheets total
Each worksheet has about 400 rows of data and anything from 6-58 columns
~160,000 rows of data total

As is probably clear from the fact that the number of columns varies, not all of the headers are consistent - but many are commonly occuring.

I found the consolidate tool, and this had the potential to make my task very simple, but the problem I have is it doesn't appear to have the option to simply append data.

For example, the simplest worksheet has headers:

Supplier (common to all - fixed position, Column A, repeating values)
Date (common to all - moves, repeating values)
Qty (common to all - moves, repeating values)
Low (common to all - moves, repeating values)
High (common to all - moves, repeating values)
Renew (only present in the very old worksheets but I wish to retain this column)


The most complicated has:

Supplier
ContactName
Tel1
Tel2
Add1
Add2
Add3
Add4
Add5
Added
LastActivity
Date
Qty
Low
High
RandomA (occassionally repeating values, not always present)
RandomB (occassionally repeating values, not always present)
...
(and more)


I need to combine these many worksheets so that ALL headers from ALL sheets are present in the consolidated worksheet and that the matching columns are appended into one huge worksheet.

Thankfully Excel 2007 allows more than 65536 rows so I assume this is possible, I just need a way to use the consolidate function to do what it does without performing any calculations... or an alternative solution.

Excel 2007 seems very powerful and much easier to use. I hope this is doable without resorting to complex macros as the time it would take to code all the different variables for column headers etc. would probably take as long as cutting and pasting manually.

Praying for some replies

 

[p45cal]

1. Are the headers ALWAYS on row 1 of each sheet?
2. Are all the sheets in each of the 18 workbooks to be processed.
3. Are all of the 18 workbooks already open, or are they together in a folder somewhere?
A macro is very, very probably the way to go, but it's not that complex and the headers should be determinable automatically.

 

[pglove]

Thanks for the response p45cal

1. Yes the headers are ALWAYS on row 1, starting from A1, but the order changes.
2. All are to be processed
3. All in 1 folder

I suspected a macro would be necessary but dreaded it.

Not sure if this is relevant, but some data in will be occassionally be blank... is this likely to pose a problem? There will always be a column header, and a lot of data but not always a value in every cell under those column headers.

 

[p45cal]

Copy/Paste the code below to a workbook's standard code-module. Run it.
It will create a new sheet in that workbook to receive the merged data. It will ask you to (multi-)select the files you want to process. Then it will takes those files, one at a time and:

open it
run through all the sheets in that file, one at a time and:

go through all the headers in row 1 of that sheet
if it's a new header, add it to the destination sheet
copy data from that column to the destination sheet appropriate column
​

close the file (without saving)
​

It will fail if on any sheet there's no cells with text on row 1.

Because it uses the 'usedrange' of each sheet, which is not always the actual used range (it's often bigger than the actual used range) you may find a number of blank rows in the resultant new sheet.
The left to right order of headers is solely dependant on the order of headers as they're found on the sheets examined. You can sort the resultant sheet horizontally to get similar headers adjacent.
Good luck.

Sub blah()
Dim rngHdr As Range, HdrsToCopy As Range, DestRow As Range
Dim AllHeaders()
ReDim AllHeaders(0 To 0)
With ThisWorkbook
  Set DestSheet = .Sheets.Add(after:=.Sheets(.Sheets.Count))
End With  'thisworkbook
With DestSheet
  Set DestRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)  'or any other column.
End With  'DestSheet
filenames = Application.GetOpenFilename("Excel files,*.xls*", MultiSelect:=True)
If IsArray(filenames) Then
  For Each fName In filenames
    Set WkBk = Workbooks.Open(fName)
    For Each sht In WkBk.Sheets
      rowscount = sht.UsedRange.Rows.Count - 1
      For Each cll In sht.Rows(1).SpecialCells(xlCellTypeConstants, xlTextValues).Cells
        NewHeader = False
        HeaderColumn = 0
        For i = LBound(AllHeaders) To UBound(AllHeaders)
          If AllHeaders(i) = cll.Value Then
            HeaderColumn = i
            Exit For
          End If
        Next i
        If HeaderColumn = 0 Then
          If UBound(AllHeaders) = 0 Then ReDim AllHeaders(1 To UBound(AllHeaders) + 1) Else ReDim Preserve AllHeaders(1 To UBound(AllHeaders) + 1)
          AllHeaders(UBound(AllHeaders)) = cll.Value
          HeaderColumn = UBound(AllHeaders)
          NewHeader = True
        End If
        If NewHeader Then DestSheet.Cells(1, HeaderColumn).Value = AllHeaders(HeaderColumn)
        cll.Offset(1).Resize(rowscount).copy DestRow.Offset(, HeaderColumn - 1)
      Next cll
      Set DestRow = DestRow.Offset(rowscount)
    Next sht
    WkBk.Close False
  Next fName
End If
End Sub

ps.
re:

but some data in will be occassionally be blank... is this likely to pose a problem? There will always be a column header, and a lot of data but not always a value in every cell under those column headers.

Shouldn't be a problem.

 

[pglove]

p45cal I owe you a drink!

This worked PERFECTLY.

I created a new Macro-enabled workbook, created and edited a new macro, inserted your macro, saved and ran it on the first workbook to test it.

Took about 10 minutes but I verified it and everything is there, you are a legend!

I will now run it on the rest!

Many thanks,

pglove

 

[excelliot]

Yes, really unique code and helped me also.

Thanks .

 

[excelliot]

Yes, really unique code and helped me also.

Thanks .

I dont know how it ran find in first occurance but on following line :
Set DestRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)

I get error "compile error method or data member not found excel " and .rows part is highlighted.

 

[p45cal]

in context:

With [COLOR=Blue]DestSheet[/COLOR]
Set DestRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)  
End With  'DestSheet

which actually translates to:

Set DestRow = [COLOR=Blue]DestSheet[/COLOR].Cells([COLOR=Blue]DestSheet[/COLOR].Rows.Count, "A").End(xlUp).Offset(1)

In this case DestSheet was a worksheet.
If you code hasn't set the With object, or the With object doesn't have a .Rows property, or your code doesn't use a With object at all, it's going to complain.

 

[excelliot]

I got same error again even after changing code as given by you.

Infact for each .Row statement i am getting error.

Do i need to declare

Dim Row as Rows

</?>

 

[p45cal]

Show all your code for this sub.