Macro to consolidate multiple sheets with varying columns

[osullivanja]

Hi,

I have a tricky situation I'm working through here and I'd appreciate some help.

I have output from a program that converts pdf phone bills and makes a summary in Excel. However when there's thousands of bills these summaries sometimes need to be done in parts, say 1-2 thousand at a time. What I want to do is consolidate these summaries in to 1 sheet.

The problem is because the conversion is done in parts, the columns won't match exactly so the consolidate feature won't work. You'll get a better idea of why if you take a look at the sample data below.

Up to a certain point the columns are identical, which is always the same column. After that however, each sheet may contain different columns. The headings of these columns, if they match, will have the exact same name but they may not be in the same column.

To start with, I've copied the column headings from all sheets in to a master sheet and removed the duplicates. So now I have all the possible columns in the master sheet. What I've managed to do so far is to take the columns that match and copy them in to a new sheet.

So now I'm up to the point where I need to start checking if each of the variable column headings in the first summary exists in the master sheet and if it does, copy all the rows and then move on to the next sheet.

I'm not that experienced with Excel VBA so this is quite tricky for me and it's been a nightmare trying to find a solution online as it's difficult to describe. I found some software, DigDB, that does exactly this but it only has a 15 day trial and if you subscribe it renews automatically. Some reviews I read said that they had trouble contacting the developer so I thought I'd take a shot at it myself.

This is a sample spreadsheet with my desired output
https://docs.google.com/spreadsheet/ccc?key=0Ak7ET7Q86O0cdGdfY2VNT180Tk9aMW9LaUcxSEk3bGc

To keep the data small, I'm saying everything up to column E will always be the same and in the same order. It's all the rows after that that I need to check for now.

I hope someone can put me on the right path with this! I appreciate you taking the time

 

[Andrew Poulsom]

Welcome to MrExcel.

You can use the Find method to return the number of the first column containing data, eg

Sub FindColumn()
    Dim Col As Long
    Dim LastRow As Long
    Dim Rng As Range
    With ActiveWorkbook.Worksheets("Sheet1")
        On Error Resume Next
        Col = .Rows(1).Find(What:="Discount100LocalSMSfree", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
        If Err <> 0 Then
            Err.Clear
        Else
            LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row
            Set Rng = .Cells(1, Col).Resize(LastRow)
            MsgBox Rng.Address
        End If
    End With
End Sub

 

[osullivanja]

Welcome to MrExcel.

You can use the Find method to return the number of the first column containing data, eg

Sub FindColumn()
    Dim Col As Long
    Dim LastRow As Long
    Dim Rng As Range
    With ActiveWorkbook.Worksheets("Sheet1")
        On Error Resume Next
        Col = .Rows(1).Find(What:="Discount100LocalSMSfree", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
        If Err <> 0 Then
            Err.Clear
        Else
            LastRow = .Cells(.Rows.Count, Col).End(xlUp).Row
            Set Rng = .Cells(1, Col).Resize(LastRow)
            MsgBox Rng.Address
        End If
    End With
End Sub

Thanks for the welcome

I wasn't able to get your code to find the column, strangely enough but I was able to figure out how to do it myself. I thought it would be pretty complicated as I was thinking about it but as I started working through it I was able to get it done. (I'm not saying I've done it in a simple way but it works!)

The problem is that the variable column headings will always change so I wanted to find them by using a variable.

Here's a sample table to use:
https://docs.google.com/spreadsheet/ccc?key=0Ak7ET7Q86O0cdHczeE9lbVJXbHp4Vmp2SnFjYkR0TFE

If someone wants to use this for themselves then you just have to watch out for the hard-coded column where it copies columns 1 to 5 first and then later where it checks from column 6 onward for variable columns. It might not be good to hard code the columns but for my data the amount of columns that are always there in the right order is 196! So this makes it run faster for me.
Also you should make sure your workbook only has the sheets you want to consolidate.

And here's my code:

Sub Macro1()'
' Macro1 Macro
'


'
'Set this to True if you want to see it working
    Application.ScreenUpdating = False
    Dim count As Integer
    count = Worksheets.count
    
    'Create new sheet to find how many columns in total
    Sheets.Add After:=Sheets(count)
    ActiveSheet.Name = "Test Grid"
    
    'Loop copies columns from each sheet in to Test Grid
    Dim i As Integer
    For i = 1 To count
    
    Sheets(i).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Test Grid").Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Selection.End(xlDown).Select
    
    Next i
    
    'Remove duplicates in Test Grid and Transpose to Master Data sheet
    Application.CutCopyMode = False
    Range("A1").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    ActiveSheet.Range("$A:$A").RemoveDuplicates Columns:=1, Header:=xlNo
    Dim colCount As Integer
    colCount = ActiveSheet.Range("A65536").End(xlUp).Row
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Name = "Master Data"
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A2").Select
    
    
    'Count - 2 because of Test Grid and Master Data
    For i = 1 To Sheets.count - 2
    
    Sheets(i).Select
    
    Dim rowCount As Integer
    rowCount = ActiveSheet.Range("A65536").End(xlUp).Row
    '5 is the index of the column where data is the same for all sheets
    'This loop copies the data from columns 1 to 5 in to Master Data
    Range("A2", Cells(rowCount, 5)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Master Data").Select
    ActiveSheet.Paste
    Cells(ActiveSheet.Range("A65536").End(xlUp).Row + 1, 1).Select
    
    Next i
    
    'Create lastRow to keep track of where to append the 2nd, 3rd, etc. sheets in Master Data
    'First it will be 1, when moving on to the next sheet lastRow will become rowCount + 1
    Dim LastRow As Integer
    LastRow = 1
    For i = 1 To Sheets.count - 2
    
    Sheets(i).Select
    'Change rowCount and colCount for each sheet as it goes through
    rowCount = ActiveSheet.Range("A65536").End(xlUp).Row
    colCount = ActiveSheet.Range("XFD1").End(xlToLeft).Column
    
    '6 is the start of the variable columns
    Dim varHead As Integer
    varHead = 6
    
    Dim x As Integer
    For x = varHead To colCount
    
    'colHead is the Value of the variable Column heading
    Dim colHead As String
    colHead = Cells(1, varHead).Value
    
    'Search for colHead in Master Data
    Sheets("Master Data").Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    
    Dim Rng As Range
    Set Rng = Cells.Find(What:=colHead, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False)
        
    'If colHead exists, copy the column from the sheet to Master Data
    If Not Rng Is Nothing Then
        Rng.Activate
        ActiveCell.Offset(LastRow, 0).Select
        Sheets(i).Select
        Range(Cells(2, varHead), Cells(rowCount, varHead)).Select
        Selection.Copy
        Sheets("Master Data").Select
        ActiveSheet.Paste
    End If
    
    varHead = varHead + 1
    Sheets(i).Select
    Next x
    '-1 for some reason, I don't know!
    LastRow = LastRow - 1
    LastRow = LastRow + rowCount
    Next i
    
End Sub

I hope it helps someone else.

 

[CharBram]

osullivanja,

Thanks so much for posting your code! I copied it for my purposes and then started diving into it step by step executing it line by line. I hadn't though of using that method to solve my issue but it makes total sense now! I, very surprisingly, didn't have to make ANY modifications to your code in order to make it work! lol

Thanks again!