Add Pivot Table to Sequential Worksheets

Question

First THANK YOU everyone who's contributed to this forum. The following is a result of all that help. I've taken an entire db of sales data and separated on different sheets by saleman. Now I want to summarize the data in a pivot table on each sheet. The problem is: this uses new data each iteration, but it only updates the first Pivot Table. What's NOT changing is this statement:

 Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this     Macro)

In every case, the PvtTbl remains "John"

Do I need to clear the Pivot Tables at the start?

   Sub Pivot_Maker() 'from internet

    Dim FinalRow            As Long
    Dim DataSheet           As String
    Dim PvtCache            As PivotCache
    Dim PvtTbl              As PivotTable
    Dim DataRng             As Range
    Dim TableDest           As Range

    Salesman(0) = "John"
    Salesman(1) = "Joe"
    Salesman(2) = "Jody"
    Salesman(3) = "Jack"
    Salesman(4) = "Junior"
    Salesman(5) = "Janet"
    Salesman(6) = "Jona"
    NumSalesPeeps = UBound(Salesman)

    i = 0

    Do While i < NumSalesPeeps
        Sheets(Salesman(i)).Select

            FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
            DataSheet = ActiveSheet.Name
            PvtTblName = ActiveSheet.Name & "pvt"

        ' set data range for Pivot Table
        Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 10))  ' conversion of R1C1:R & FinalRow & C8

'*************************************************************
    DataRng.Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 60407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

'*******************************************************



        ' set range for Pivot table placement
        Set TableDest = Sheets(DataSheet).Cells(1, 12)  ' conversion of R1C9

'***********************************************
    TableDest.Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

'***********************************************

        Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)

        ' this line in case the Pivot table doesn't exit >> first time running this Macro
        On Error Resume Next
        Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this Macro)

        On Error GoTo 0
        If PvtTbl Is Nothing Then ' PvtTblName doesn't exist >> create it

            ' create a new Pivot Table in PvtTblName sheet
            Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:=PvtTblName)


        With PvtTbl.PivotFields("Account")
                .Orientation = xlColumnField
                .Position = 1
            End With
            With PvtTbl.PivotFields("Name")
                .Orientation = xlRowField
                .Position = 1
            End With
            PvtTbl.AddDataField ActiveSheet.PivotTables( _
            PvtTblName).PivotFields("Amount"), "Sum of Amount", xlSum

        Else
            ' just refresh the Pivot cache with the updated Range
            PvtTbl.ChangePivotCache PvtCache
            PvtTbl.RefreshTable
        End If
i = i + 1
Loop
End Sub

It will be easier to troubleshoot and maintain your code if you follow the guidelines here: https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — Tim Williams, Nov 20 '19 at 00:00

score 0 · Answer 1 · answered Nov 20 '19 at 20:40

I think I've got it. The solution lay in changing the PivotTable number. I did so by making PivotTable an Array in the declaration, then using the Do While index to assign the array index. Again, I did very little of this on my own. THANK YOU community for posting such helpful guidance!

Sub Pivot_Maker() 'from internet

Dim FinalRow            As Long
Dim DataSheet           As String
Dim PvtCache            As PivotCache
Dim PvtTbl(7)              As PivotTable
Dim DataRng             As Range
Dim TableDest           As Range

Salesman(0) = "House"
Salesman(1) = "Guy1"
Salesman(2) = "Gal1"
Salesman(3) = "Guy2"
Salesman(4) = "Gal2"
Salesman(5) = "Chucky"
Salesman(6) = "Kenny"
NumSalesPeeps = UBound(Salesman)

i = 0

Do While i < NumSalesPeeps
    Sheets(Salesman(i)).Select

        FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
        DataSheet = ActiveSheet.Name
        PvtTblName = ActiveSheet.Name & "pvt"

        ' set data range for Pivot Table
        Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 10))  ' conversion of R1C1:R & FinalRow & C8

        ' set range for Pivot table placement
        Set TableDest = Sheets(DataSheet).Cells(1, 12)  ' conversion of R1C9


        Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng)

        ' this line in case the Pivot table doesn't exit >> first time running this Macro
        On Error Resume Next
        Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables(PvtTblName) ' check if PvtTblName Pivot Table already created (in past runs of this Macro)

        On Error GoTo 0
        If PvtTbl(i) Is Nothing Then ' PvtTblName doesn't exist >> create it

            ' create a new Pivot Table in PvtTblName sheet
            Set PvtTbl(i) = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:=PvtTblName)


        With PvtTbl(i).PivotFields("Account")
                .Orientation = xlColumnField
                .Position = 1
            End With
            With PvtTbl(i).PivotFields("Name")
                .Orientation = xlRowField
                .Position = 1
            End With
            PvtTbl(i).AddDataField ActiveSheet.PivotTables( _
                PvtTblName).PivotFields("Amount"), "Sum of Amount", xlSum

        Else
            ' just refresh the Pivot cache with the updated Range
            PvtTbl(i).ChangePivotCache PvtCache
            PvtTbl(i).RefreshTable
        End If
i = i + 1
Loop
End Sub

Add Pivot Table to Sequential Worksheets

1 Answers1