Combine multiple rows of data from multiple worksheets

[jloughney]

Hi Everyone,

I have been working on this problem for a while now and can't seem to find a solution, I am hoping one you may be able to help. I am using Excel 2007 on Windows 7.

I have been given a xls file containing multiple worksheets and my task is to combine this data on a summary sheet and where there are duplicates, the quantity value is increased, but no duplicates are added to the summary.

So for example, on sheet 1 I could have :
ID Quantity Description
344303 1 product 1
342910 2 product 2
344411 1 product 3

On sheet 2:

ID Quantity Description
344303 4 product 1
342910 6 product 2

The output on the summary sheet should be:
ID Quantity Description
344303 5 product 1
342910 8 product 2
344411 1 product 3

I am very new to VBA and only have limited experience with Excel. Firstly how can I go about getting all the information from the multiple sheets and add them to the summary sheet? Then how would I be able to loop over them, find duplicates and increase the Quantity column?

Any help you can provide would be greatly appreciated.

 

[Domenic]

Assuming that a summary sheet already exists, try...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=green]'Declare variables[/color]
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] wks [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] LastColumn [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=green]'Turn off screen updating[/color]
    Application.ScreenUpdating = [color=darkblue]False[/color]

    [color=green]'Assign summary sheet to variable (change the sheet name accordingly)[/color]
    [color=darkblue]Set[/color] wksDest = Worksheets("Summary")
    
    [color=green]'Clear summary sheet for transfer of data[/color]
    wksDest.Cells.Clear
    
    [color=green]'Insert headers (change the sheet name for Sheet1 accordingly)[/color]
    Worksheets("Sheet1").UsedRange.Rows(1).Copy wksDest.Range("A1")
    
    [color=green]'Loop through each worksheet in the active workbook[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] wks [color=darkblue]In[/color] ActiveWorkbook.Worksheets
        [color=green]'Exclude the summary sheet[/color]
        [color=darkblue]If[/color] wks.Name <> "Summary" [color=darkblue]Then[/color]
            [color=green]'Copy the data from the current worksheet to the summary sheet[/color]
            [color=darkblue]With[/color] wks.UsedRange
                .Offset(1, 0).Resize(.Rows.Count - 1).Copy wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp)(2)
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        End [color=darkblue]If[/color]
    [color=darkblue]Next[/color] wks
        
    [color=darkblue]With[/color] wksDest
        [color=green]'Find the last used row in Column A of the summary sheet[/color]
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        [color=green]'Find the last used column in Row 1 of the summary sheet[/color]
        LastColumn = .Cells(1, .Columns.Count).[color=darkblue]End[/color](xlToLeft).Column
        [color=green]'Sort the data[/color]
        [color=darkblue]With[/color] .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
            .Sort Key1:=.Cells(1, 1).Value, order1:=xlAscending, key2:=.Cells(1, 3).Value, order2:=xlAscending, _
                Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTop[color=darkblue]To[/color]Bottom
        [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=green]'Combine the data and delete duplicates[/color]
        [color=darkblue]For[/color] i = LastRow To 2 [color=darkblue]Step[/color] -1
            [color=darkblue]If[/color] .Cells(i, 1).Value = .Cells(i - 1, 1).Value And .Cells(i, 3).Value = .Cells(i - 1, 3).Value [color=darkblue]Then[/color]
                .Cells(i - 1, 2).Value = .Cells(i - 1, 2).Value + .Cells(i, 2).Value
                .Rows(i).Delete
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=green]'Turn back on screen updating[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    [color=green]'Alert user that task has been completed[/color]
    MsgBox "Completed...", vbInformation
    
End [color=darkblue]Sub[/color]
[/font]

 

[jloughney]

Hi Domenic,

Thank you so much for your help with this. I have tried your code and it works perfectly. I don't think I would have been able to figure this out in the time allowed. Just out of interest, how did you learn this? Any books that you can recommend?

I really appreciate all your help.

Best Regards,


James

 

[Domenic]

Hi Domenic,

Hi James!

Thank you so much for your help with this.

You're very welcome!

Just out of interest, how did you learn this? Any books that you can recommend?

I'm learning by doing some reading and by participating in this forum. I'd recommend a book by John Walkenbach called "Excel 2007, Power Programming with VBA". Although, he might have a more recent book.