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:=xlDatabase, 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:=xlDatabase, 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:=xlDatabase, 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:=xlDatabase, 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.