Adding PivotTable with Filters into Loop-CodePudding

I'm still learning VBA and I am trying to get my current code loop to filter all the available pivot tables with same fields and columns. However, I'm unable to get the pivots in the loop to be activated. Please reference my below code with the issue starting with "insert fields for pivot". Any help is appreciated.

'Loop through array for sheet names
For n = UBound(wsNames) To LBound(wsNames) Step -1
Set subWS = wb.Worksheets.Add(After:=ws)
'rename ws using sheet names array
subWS.Name = wsNames(n)
If IsArray(ccNumbers(n)) Then 'multiple group numbers in array
    dataRG.AutoFilter 7, ccNumbers(n), xlFilterValues
Else
    dataRG.AutoFilter 7, ccNumbers(n) 'x;And' is default (irrelevant)
End If
Set dfCell = subWS.Range("A1")
'copy column widths
dataRG.Rows(1).Copy
dfCell.PasteSpecial xlPasteColumnWidths
'select first cell as selection is first row by product of 'PasteSpecial
dfCell.Select
'copy visible cells only
dataRG.SpecialCells(xlCellTypeVisible).Copy dfCell
'set range for subws
Set subRG = subWS.Range("A1").CurrentRegion
'Format each sheet as a table
subWS.ListObjects.Add(SourceType:=xlSrcRange, Source:=subRG).Name = TbleNames(n)
'Add new WS for pivots
Set pvtWS = Sheets.Add(After:=subWS)
pvtWS.Name = PvtNames(n)
'Define Pivot Caches
Set subCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=subRG)
'Create Pivot Tables
Set subPvtTable = subCache.CreatePivotTable(TableDestination:=pvtWS.Cells(1, 1))
subPvtTable.Name = PTNames(n)

'Insert Fields for Pivot
With ActiveTable.subPvtTable

'Insert Filters for Pivot
With .pivotfields("Cost Center")
.Orientation = xlPageField
.Position = 1
End With

'Insert Row Fields for Pivot
With .pivotfields("OrgName")
.Orientation = xlRowField
.Position = 1
End With

'Insert Value Fields for Pivot
With .pivotfields("Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "$#,##0.00"
End With


End With
next n

CodePudding user response：

Fixed the With and added a test to check whether all data rows have been hidden, to avoid adding the two sheets for the subset table and pivot.

'Loop through array for sheet names
For n = UBound(wsNames) To LBound(wsNames) Step -1
    
    If IsArray(ccNumbers(n)) Then 'multiple group numbers in array
        dataRG.AutoFilter 7, ccNumbers(n), xlFilterValues
    Else
        dataRG.AutoFilter 7, ccNumbers(n) 'x;And' is default (irrelevant)
    End If
    'were all data rows filtered out?
    If dataRG.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
        Set subWS = wb.Worksheets.Add(After:=ws)
        subWS.Name = wsNames(n) 'rename ws using sheet names array
        
        Set dfCell = subWS.Range("A1")
        dataRG.Rows(1).Copy 'copy column widths
        dfCell.PasteSpecial xlPasteColumnWidths
        dataRG.SpecialCells(xlCellTypeVisible).Copy dfCell 'copy visible cells only
        
        Set subRG = subWS.Range("A1").CurrentRegion
        subWS.ListObjects.Add(SourceType:=xlSrcRange, Source:=subRG).Name = TbleNames(n)
        
        Set pvtWS = Sheets.Add(After:=subWS)
        pvtWS.Name = PvtNames(n)
        
        Set subCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=subRG)
        Set subPvtTable = subCache.CreatePivotTable(TableDestination:=pvtWS.Cells(1, 1))
        subPvtTable.Name = PTNames(n)
        
        With subPvtTable
            With .PivotFields("Cost Center")
                .Orientation = xlPageField
                .Position = 1
            End With
            With .PivotFields("OrgName")
                .Orientation = xlRowField
                .Position = 1
            End With
            With .PivotFields("Amount")
                .Orientation = xlDataField
                .Function = xlSum
                .NumberFormat = "$#,##0.00"
            End With
        End With
    End If 'any filtered data
Next n