Search code examples
excelvbaloopspivotpivot-table

Adding PivotTable with Filters into Loop


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

Solution

  • 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.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then  'FIXED
            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