Cannot count visible items in filtered pivot table correctly

[whitehawk81]

Hi,
I have an issue with pivot tables, that's bugging me. I cannot get the correct count of visible items in pivot tables after changing the filters via VBA.
Here is the code, that should grab every pivot table that has more than 1 row in the data body range:

Sub changePTfilter(ws As Worksheet, sID As Long)
Dim pt As PivotTable
Dim pf As PivotField
Dim ptName As String
Dim i, n As Long


n = ws.Cells(Rows.Count, 1).End(xlUp).row


Call TU_Start
On Error Resume Next


For i = 1 To ws.PivotTables.Count
ptName = "SolPT" & i
Set pt = ws.PivotTables(ptName)


pt.ManualUpdate = True


Set pf = pt.PivotFields("Solution")
    With pf
        .ClearAllFilters
        .CurrentPage = sID
    End With


    If i < 7 And pf.CurrentPage <> "(All)" Then
        If pt.DataBodyRange.Count > 1 Then    '--- this is the problematic part
            ws.Cells(n, 1).Value = i
            n = n + 1
        End If
    End If


Set pf = Nothing
    With pt
        .PivotCache.Refresh
    End With


pt.ManualUpdate = False


Next i


Call TU_End


End Sub

The closest I got so far is when I looped through all visible items in the pivot field, but that also counted the items, that were filtered out:

For Each pf In pt.RowFields          
Debug.Print pf.Name & ": " & pf.VisibleItems.Count
    Next

 

[whitehawk81]

I actually managed to solve it by creating a separate subroutine for the loop after the pivot tables have been updated. Maybe not the most elegant way, but works.

Sub listUsedCharts(ws As Worksheet, pt As PivotTable, pf As PivotField)
Dim i, n As Long
Dim ptName As String


n = ws.Cells(Rows.Count, 1).End(xlUp).row


For i = 1 To 6
ptName = "SolPT" & i
Set pt = ws.PivotTables(ptName)
Set pf = pt.PivotFields("Solution")


    If pf.CurrentPage <> "(All)" Then
        If pt.DataBodyRange.Count > 1 Then
            ws.Cells(n, 1).Value = i
            n = n + 1
        End If
    End If
Next i


End Sub