Pivot Table Filter Excel VBA One by One
Sub LoopThroughFilters()
Dim annoying As Double
Dim driversdict As Object, drivers As Variant, i As Long, Driver As Variant
Set driversdict = CreateObject("Scripting.Dictionary")
With ActiveSheet
'puts autofilter on all columns
If Not .AutoFilterMode Then .UsedRange.AutoFilter
If .Cells.AutoFilter Then .Cells.AutoFilter
'Create list of unique things to filter by in column P
If Range("P3").Value <> "" Then
annoying = 2
drivers = Range(.Range("P2"), .Cells(Rows.Count, "P").End(xlUp))
For i = 1 To UBound(drivers, 1)
driversdict(drivers(i, 1)) = 1
counts = counts + 1
Next
Else
Driver = Range("P2").Value
annoying = 1
End If
End With
Sheets("Sheet2").Select
With ActiveSheet.PivotTables("Pivottable1").PivotFields("Date")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("Pivottable1").PivotFields("Date").CurrentPage = _
"(All)"
Dim counter2 As Double
counter2 = 1
Dim key As Double
key = 1
For Each Driver In driversdict.keys
If key = 2 Then
GoTo line80:
End If
With ActiveSheet.PivotTables("Pivottable1").PivotFields("Date")
ActiveSheet.PivotTables("Pivottable1").PivotFields("Date").CurrentPage = _
"(All)"
With ActiveSheet.PivotTables("Pivottable1").PivotFields("Date")
For i = 1 To .PivotItems.Count
If i = ActiveSheet.PivotTables("Pivottable1").PivotFields("Date").PivotItems.Count Then
GoTo line6:
End If
.PivotItems(i).Visible = False
Next
line6:
End With
ActiveSheet.PivotTables("Pivottable1").PivotFields("Date"). _
EnableMultiplePageItems = True
line80:
With ActiveSheet.PivotTables("Pivottable1").PivotFields("Date")
.PivotItems(Driver).Visible = True
End With
If key = 2 Then
With ActiveSheet.PivotTables("Pivottable1").PivotFields("Date")
.PivotItems(counter2).Visible = False
End With
counter2 = counter2 + 1
End If
If key <> 2 Then
.PivotItems(i).Visible = False
key = 2
End If
End With
Next
End Sub
Here's the code again in image format if you like to read it and copy it from the screen.