Copy pivottables subtotal to new sheet.

[jwitte]

I am running a query inputing on for seperate sheet and then making four pivot tables (CW, MS, LF, US) based on that data to a 5 sheet. Each have multiple rows(BSP, BWF, CTC, etc) Filtered done by a date range i am using in a input box. I am runing a loop that displays only the rows with data and the subtotal. So there could be a row in one table thats not in another. What i need is to copy the row subtotal from each pivot table to a new sheet. So if theres a value under BSP it would copy that row subtotal to a new sheet call All totals. It would then add up all subtotals for each of the four pivottables and give me a grand total for that row. If the row has no value it would insert a "0"

example:
CW LF MS US
BSP 1051 BSP 470 BSP 1596 BSP 320
BWF 23 BWF 30 BWF 45

I would like the following to be displayed on a new sheet. As you can see some pivot tables may or may not have certain rows.

grand total for BSP is 3437
grand total for BWF is 98

so on and so forth with all row subtotals

I having issues with coping the row suptotals to a new page. Any help would definately be appreciated. Also if you have any hints to clean up my coding by all means let me know. Im definately not the greatest with vba all self taught here. Below is the code I am using. Please forgive me if im not the clearest. Thanks all in advance



Sub PivotTables()
'
' Pivot Table for CW LF MS US Macro
' ctrl-z
'

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

Dim LR As Long
Dim cl As Range
Dim PT As pivottable
Dim PI As PivotItem
Dim PF As PivotField
Dim StartDate As String
Dim EndDate As String
Dim OutApp As Object
Dim OutMail As Object
Dim Subj As String
Dim i, LastRow
Dim answer As Integer
Dim Total As Long


'*******************FILERTERING CODE DOWN TO OUR STATES******************************

Sheets("CW").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 1 Step -1
If Cells(i, "A").Value = "AZ" _
Or Cells(i, "A").Value = "CA" _
Or Cells(i, "A").Value = "NV" Then
Cells(i, "A").EntireRow.Delete
End If
Next

Sheets("LF").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 1 Step -1
If Cells(i, "A").Value = "AL" _
Or Cells(i, "A").Value = "FL" _
Or Cells(i, "A").Value = "GA" _
Or Cells(i, "A").Value = "MS" _
Or Cells(i, "A").Value = "NY" _
Or Cells(i, "A").Value = "PA" _
Then
Cells(i, "A").EntireRow.Delete
End If
Next

Sheets("MS").Select
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = LastRow To 1 Step -1
If Cells(i, "A").Value = "NC" _
Or Cells(i, "A").Value = "SC" _
Then
Cells(i, "A").EntireRow.Delete
End If
Next

'********************DATE RANGE CODE********************************************** ********************
Sheets("Totals").Select
Cells.Select
Selection.Delete Shift:=xlUp

StartDate = InputBox("What is the Start Date?", "Choose Start Date", "Enter starting Date Here yyyymmdd")
EndDate = InputBox("What is the End Date", "Choose End Date", "Enter ending Date Here yyyymmdd")

'*******************MS PIVOT TABLE CODE********************************************** ****************

Sheets("CW").Select
Cells.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa tabase, SourceData:= _
"CW!R1C1:R1048576C8", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Totals!R3C1", TableName:="CW", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Totals").Select
Cells(3, 1).Select

With ActiveSheet.PivotTables("CW").PivotFields("Stage")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("CW").PivotFields("Appointment")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("CW").AddDataField ActiveSheet.PivotTables("CW"). _
PivotFields("Stage"), "Count of Stage", xlCount
With ActiveSheet.PivotTables("CW").PivotFields("Stage")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("CW").PivotFields("Count of Stage").Caption = " "
ActiveSheet.PivotTables("CW").CompactLayoutRowHeader = "CW"

'************lf pivot table Code********************************************** ***********************

Sheets("LF").Select
Cells.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa tabase, SourceData:= _
"LF!R1C1:R1048576C8", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Totals!R3C4", TableName:="LF", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Totals").Select
Cells(3, 4).Select

With ActiveSheet.PivotTables("LF").PivotFields("STAGE")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("LF").PivotFields("APPOINTMENT")
.Orientation = xlRowField
.Position = 2
End With

ActiveSheet.PivotTables("LF").AddDataField ActiveSheet.PivotTables("LF"). _
PivotFields("STAGE"), "Count of STAGE", xlCount

With ActiveSheet.PivotTables("LF").PivotFields("STAGE")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("LF").PivotFields("Count of Stage").Caption = " "
ActiveSheet.PivotTables("LF").CompactLayoutRowHeader = "LF"

'*************************MS PIVOT TABLE CODE********************************************** *************

Sheets("MS").Select
Cells.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa tabase, SourceData:= _
"MS!R1C1:R1048576C8", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Totals!R3C7", TableName:="MS", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Totals").Select
Cells(3, 7).Select

With ActiveSheet.PivotTables("MS").PivotFields("Stage")
.Orientation = xlRowField
.Position = 1
End With

With ActiveSheet.PivotTables("MS").PivotFields("Appointment")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("MS").AddDataField ActiveSheet.PivotTables("MS"). _
PivotFields("Stage"), "Count of Stage", xlCount

With ActiveSheet.PivotTables("MS").PivotFields("Stage")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("MS").PivotFields("Count of Stage").Caption = " "
ActiveSheet.PivotTables("MS").CompactLayoutRowHeader = "MS"
'************************US PIVOTTABLE CODE********************************************** *****************

Sheets("US").Select
Cells.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa tabase, SourceData:= _
"US!R1C1:R1048576C8", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="Totals!R3C10", TableName:="US", DefaultVersion _
:=xlPivotTableVersion14
Sheets("Totals").Select
Cells(3, 10).Select

With ActiveSheet.PivotTables("US").PivotFields("Stage")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("US").PivotFields("Appointment")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("US").AddDataField ActiveSheet.PivotTables("US"). _
PivotFields("Stage"), "Count of Stage", xlCount
With ActiveSheet.PivotTables("US").PivotFields("Stage")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("US").PivotFields("Count of Stage").Caption = " "
ActiveSheet.PivotTables("US").CompactLayoutRowHeader = "US"

'************************ Sort and filter code********************************************** **************

For Each PT In ActiveSheet.PivotTables
Set PF = PT.PivotFields("Stage")
For Each PI In PF.PivotItems
If Not PI.Name = "{blank}" Then

If PI.Value = "BSP" Or _
PI.Value = "BWF" Or _
PI.Value = "CAN" Or _
PI.Value = "CTC" Or _
PI.Value = "DSP" Or _
PI.Value = "LNP" Or _
PI.Value = "MSP" Or _
PI.Value = "PSP" Or _
PI.Value = "TC" Or _
PI.Value = "TSP" Or _
PI.Value = "USP" Or _
PI.Value = "VSH" Or _
PI.Value = "VSP" Then

Range("A4").Select
ActiveSheet.PivotTables("CW").PivotSelect "BSP", xlDataAndLabel + xlFirstRow, _
True
ActiveSheet.PivotTables("MS").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("CW").InnerDetail = "Appointment"
Selection.ShowDetail = True
ActiveSheet.PivotTables("CW").PivotSelect "BSP", xlDataAndLabel + xlFirstRow, _
True
Range("D4").Select
ActiveSheet.PivotTables("LF").InnerDetail = "Appointment"
Selection.ShowDetail = True
Range("G4").Select
ActiveSheet.PivotTables("MS").InnerDetail = "Appointment"
Selection.ShowDetail = True
Range("j4").Select
ActiveSheet.PivotTables("US").InnerDetail = "Appointment"
Selection.ShowDetail = True

PI.Visible = True
PI.ShowDetail = True
Else
PI.Visible = False
End If

End If
Next PI
Next PT

ActiveSheet.PivotTables("CW").PivotFields("Stage").Subtotals = Array(True, _
False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("CW").PivotFields("Appointment").Subtotals = Array( _
True, False, False, False, False, False, False, False, False, False, False, False)

ActiveSheet.PivotTables("LF").PivotFields("Stage").Subtotals = Array(True, _
False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("LF").PivotFields("Appointment").Subtotals = Array( _
True, False, False, False, False, False, False, False, False, False, False, False)

ActiveSheet.PivotTables("MS").PivotFields("Stage").Subtotals = Array(True, _
False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("MS").PivotFields("Appointment").Subtotals = Array( _
True, False, False, False, False, False, False, False, False, False, False, False)

ActiveSheet.PivotTables("US").PivotFields("Stage").Subtotals = Array(True, _
False, False, False, False, False, False, False, False, False, False, False)
ActiveSheet.PivotTables("US").PivotFields("Appointment").Subtotals = Array( _
True, False, False, False, False, False, False, False, False, False, False, False)

For Each PT In ActiveSheet.PivotTables
Set PF = PT.PivotFields("Appointment")
For Each PI In PF.PivotItems
If Not PI.Name = "{blank}" Then

If _
PI.Value >= StartDate And _
PI.Value <= EndDate Then
PI.Visible = True
Else
PI.Visible = False
End If
End If
Next PI
Next PT
ActiveSheet.PivotTables("US").ShowDrillIndicators = False
ActiveSheet.PivotTables("US").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("CW").ShowDrillIndicators = False
ActiveSheet.PivotTables("CW").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("LF").ShowDrillIndicators = False
ActiveSheet.PivotTables("LF").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("MS").ShowDrillIndicators = False
ActiveSheet.PivotTables("MS").TableStyle2 = "PivotStyleMedium9"
ActiveSheet.PivotTables("MS").ShowDrillIndicators = False
ActiveSheet.PivotTables("MS").TableStyle2 = "PivotStyleMedium9"

Range("A3").Select
With ActiveSheet.PivotTables("CW")
.ColumnGrand = False
.RowGrand = False
End With
Range("D3").Select
With ActiveSheet.PivotTables("LF")
.ColumnGrand = False
.RowGrand = False
End With
Range("G3").Select
With ActiveSheet.PivotTables("MS")
.ColumnGrand = False
.RowGrand = False
End With
With ActiveSheet.PivotTables("US")
.ColumnGrand = False
.RowGrand = False
End With

End Sub

[Admin]

Hi

Can you please upload a sample workbook with the expected results ?

[jwitte]

Hi

Can you please upload a sample workbook with the expected results ?




Sorry about that I have attached a snippet of what I am try to get accomplished. Thanks

[Admin]

Hi

Try this.


Sub kTest()

Dim dicEnviro As Object, i As Long, j As Long, k, q, t
Dim wksAllTotals As Worksheet, wksTotals As Worksheet

Set dicEnviro = CreateObject("scripting.dictionary")
dicEnviro.comparemode = 1

Set wksAllTotals = ThisWorkbook.Worksheets("All Total Calc")
Set wksTotals = ThisWorkbook.Worksheets("Totals")

q = wksAllTotals.Range("b2").CurrentRegion.Resize(, 2).Value2

For i = 1 To UBound(q, 1)
If LenB(q(i, 1)) Then
dicEnviro.Item(q(i, 1)) = Array(i, 0)
End If
Next

For j = 1 To wksTotals.PivotTables.Count
k = wksTotals.PivotTables(j).TableRange1.Value2
For i = 1 To UBound(k, 1)
t = dicEnviro.Item(k(i, 1))
If Not IsEmpty(t) Then
t(1) = t(1) + k(i, 2)
q(t(0), 2) = t(1)
dicEnviro.Item(k(i, 1)) = t
End If
Next
Next

wksAllTotals.Range("b2").CurrentRegion.Resize(, 2) = q

End Sub

[jwitte]

Hi

Try this.


Sub kTest()

Dim dicEnviro As Object, i As Long, j As Long, k, q, t
Dim wksAllTotals As Worksheet, wksTotals As Worksheet

Set dicEnviro = CreateObject("scripting.dictionary")
dicEnviro.comparemode = 1

Set wksAllTotals = ThisWorkbook.Worksheets("All Total Calc")
Set wksTotals = ThisWorkbook.Worksheets("Totals")

q = wksAllTotals.Range("b2").CurrentRegion.Resize(, 2).Value2

For i = 1 To UBound(q, 1)
If LenB(q(i, 1)) Then
dicEnviro.Item(q(i, 1)) = Array(i, 0)
End If
Next

For j = 1 To wksTotals.PivotTables.Count
k = wksTotals.PivotTables(j).TableRange1.Value2
For i = 1 To UBound(k, 1)
t = dicEnviro.Item(k(i, 1))
If Not IsEmpty(t) Then
t(1) = t(1) + k(i, 2)
q(t(0), 2) = t(1)
dicEnviro.Item(k(i, 1)) = t
End If
Next
Next

wksAllTotals.Range("b2").CurrentRegion.Resize(, 2) = q

End Sub

Hi

It could be that its to early in the morning or the fact im a total VBA newbie or the fact i didnt explain properly what i wanted here but it doesnt paste the the totals to the all totals page. It could also be that i didnt explain myself. i need it to look for the BSP in the 4 pivot tables and give me a total count of the sub total. If table "CW" has a cound of 100 for bsp and table "LF" has a count of 5 and table "MS" has a count of 10 and table "US" has a count of 15 for bsp, on the all totals page it would put BSP = 130(total for bsp in all pivot tables). I would need that for each row, and if one table does have that row it would count it as 0. And give me the total of the other pivot tables that may have a value. I need a total count for each of the following.

"BSP"
"BWF"
"CAN"
"CTC"
"DSP"
"LNP"
"MSP"
"PSP"
"TC"
"TSP"
"USP"
"VSH"
"VSP"

I am totally sorry if I sound confusing or not making sence. I want something like below but count "BSP" in all 4 tables and insert that total on the all totals sheet, and just count a 0 if one of the above stages dont exist in one of the tables. I can copy that code and change it for each stage above but it errors out if a table doesnt have that stage. I cant get it to work poperly in the loop.



ActiveSheet.PivotTables("CW").PivotSelect "BSP", xlDataAndLabel + xlFirstRow, True
Selection.Copy
Range("N4").Select
ActiveSheet.Paste

[Admin]

Hi

When I run the code on the file you attached I get the following values in B2:C14 on 'All Total Calc' sheet.


BSP 484
BWF 0
CAN 0
CTC 0
DSP 0
LNP 1
MSP 1
PSP 3
TC 0
TSP 0
USP 59
VSH 0
VSP 41

Is it what you are after ?

Note: Please do not delete any cells in B2:B14 on 'All Total Calc' sheet.
The copy pastes is happening based on these cell values.

[jwitte]

AllI can say is you are awesome. It works exactly how I want it too.