Summarizing worksheets

[Guest]

I have several worksheets that include Name, SSN, Amount columns. The data
in the worksheets may contain the same people, but do not always. For
example, Sheet 1 lists:
Jane Doe 111-11-1111 5.00
John Smith 222-22-2222 5.00
Mike Brown 333-33-3333 5.00

Sheet 2 lists:
Jane Doe 111-11-1111 1.00
Mike Brown 333-33-3333 1.00

Sheet 3 lists:
Jane Doe 111-11-1111 2.00
Mike Brown 333-33-3333 2.00
Lisa Green 444-44-4444 2.00

I need to get a summary worksheet that contains each person from the
multiple worksheets along with the total of the amount column for each
person. Example:
Sheet 4 Totals lists:
Jane Doe 111-11-1111 8.00
John Smith 222-22-2222 5.00
Mike Brown 333-33-3333 8.00
Lisa Green 444-44-4444 2.00

Is there a formula or function to accomplish this?

Please help, this is driving me crazy!

Thanks,
Yvonne

 

[Bernie Deitrick]

Yvonne,

Try the macro below. Assumes that you do not have a sheet named "Summary", that your data starts in
cell A1 and is 3 columns wide, and there are no blanks within your data tables.


HTH,
Bernie
MS Excel MVP


Sub Consolidate()
Dim mySht As Worksheet
Dim i As Integer
Dim myRow As Long
Dim PFV1 As String
Dim PFV2 As String
Dim PFV3 As String

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

On Error Resume Next
Worksheets("Summary").Delete
Worksheets("Pivot Summary").Delete
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = "Summary"

PFV1 = Worksheets(2).Cells(1, 1).Value
PFV2 = Worksheets(2).Cells(1, 2).Value
PFV3 = Worksheets(2).Cells(1, 3).Value

For i = 2 To ThisWorkbook.Worksheets.Count
myRow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(i).Range("A" & IIf(i = 2, 1, 2) & ":C" & myRow).Copy _
mySht.Cells(Rows.Count, 1).End(xlUp)(2)
Next i

Worksheets("Summary").Activate
Rows("1:1").Delete Shift:=xlUp

myRow = Range("A2").CurrentRegion.Rows.Count
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Summary!R1C1:R" & myRow & "C3").CreatePivotTable _
TableDestination:="", TableName:="PivotTable1"

ActiveSheet.Name = "Pivot Summary"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
With ActiveSheet.PivotTables("PivotTable1").PivotFields(PFV1)
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields(PFV2)
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields(PFV3), "Sum of Amounts", xlSum

ActiveSheet.PivotTables("PivotTable1").PivotFields(PFV1).Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = False
.RowGrand = False
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With


End Sub

 

[Guest]

Thank you soooo much! This worked great!

Yvonne,

Try the macro below. Assumes that you do not have a sheet named "Summary", that your data starts in
cell A1 and is 3 columns wide, and there are no blanks within your data tables.


HTH,
Bernie
MS Excel MVP


Sub Consolidate()
Dim mySht As Worksheet
Dim i As Integer
Dim myRow As Long
Dim PFV1 As String
Dim PFV2 As String
Dim PFV3 As String

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

On Error Resume Next
Worksheets("Summary").Delete
Worksheets("Pivot Summary").Delete
Set mySht = Worksheets.Add(Before:=Worksheets(1))
mySht.Name = "Summary"

PFV1 = Worksheets(2).Cells(1, 1).Value
PFV2 = Worksheets(2).Cells(1, 2).Value
PFV3 = Worksheets(2).Cells(1, 3).Value

For i = 2 To ThisWorkbook.Worksheets.Count
myRow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(i).Range("A" & IIf(i = 2, 1, 2) & ":C" & myRow).Copy _
mySht.Cells(Rows.Count, 1).End(xlUp)(2)
Next i

Worksheets("Summary").Activate
Rows("1:1").Delete Shift:=xlUp

myRow = Range("A2").CurrentRegion.Rows.Count
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Summary!R1C1:R" & myRow & "C3").CreatePivotTable _
TableDestination:="", TableName:="PivotTable1"

ActiveSheet.Name = "Pivot Summary"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
With ActiveSheet.PivotTables("PivotTable1").PivotFields(PFV1)
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields(PFV2)
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields(PFV3), "Sum of Amounts", xlSum

ActiveSheet.PivotTables("PivotTable1").PivotFields(PFV1).Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = False
.RowGrand = False
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With


End Sub