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

 

[excelliot]

It is same as given by you..

Sub blah()
Dim rngHdr As Range, HdrsToCopy As Range, DestRow As Range, DestSheet As Sheets
 
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

 

[excelliot]

Thank in Advance

 

[p45cal]

It is same as given by you..

Dim rngHdr As Range, HdrsToCopy As Range, DestRow As Range, [B][COLOR=Red]DestSheet As Sheets[/COLOR][/B]

But it's not, is it? You've added the red above. Change the red to:

DestSheet as Worksheet

 

[excelliot]

Yes, Its done... We will test this code and revert.

 

[ruby20]

But it's not, is it? You've added the red above. Change the red to:

DestSheet as Worksheet

Hi,
Just wondering how would you edit theoriginal code so that you didn't include the
new headers with its pasted data in the new merged worksheet.

Basically only joining headers that are the same and excluding the ones that arent
and pasting into the correct corrresponding columns??

alternative end code would be MUCH appreciated please and thank you!!

Ruby

 

[p45cal]

Hi,
Just wondering how would you edit the original code so that you didn't include the
new headers with its pasted data in the new merged worksheet.

What defines new in 'new headers'? It implies a set of existing headers - how are those defined?

Basically only joining headers that are the same and excluding the ones that arent

Same question; the same as what?

 

[ruby20]

But it's not, is it? You've added the red above. Change the red to:

DestSheet as Worksheet

Hi,
Just wondering how would you edit theoriginal code so that you didn't include the
new headers with its pasted data in the new merged worksheet.

Basically only joining headers that are the same and excluding the ones that arent
and pasting into the correct corrresponding columns??

alternative end code would be MUCH appreciated please and thank you!!

Ruby

 

[p45cal]

That is a copy of msg#15. It doesn't address my questions.

 

[ruby20]

What defines new in 'new headers'? It implies a set of existing headers - how are those defined?



Same question; the same as what?

i refer to "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."

Can you run the code without adding the new headers

 

[p45cal]

The code begins with no headers on the destination sheet, and adds headers as it finds them in row 1 of the source sheets as it runs through them.
If the first source sheet only has 2 headers, then the destination sheet gets those 2 (new) headers added to it, if the second sheet has more headers, it only adds the ones that are different (new) to the destination sheet, etc.

My question in msg#16 still needs answering.