Filtering Pivot Tables by Date Interval with VBA

Question

I am writing a macro to change the data in my pivot tables according to a year-month filter. As long as data in pivot table fall within 2 year-month in the following string format, it should be displayed.

2016 - 01
2016 - 05

The date intervals are also in this format. This didn't update the pivot tables at all. I appreciate any feedback or alternative to updating pivot tables given two date intervals as its filters.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim shPT As Worksheet
    Dim pt As PivotTable
    Dim pi As PivotItem

    Dim d As Date
    Dim dStart As Date
    Dim dEnd As Date

    '' G4 and G7 are the cell locations of the start and ending year-months.
    dStart = DateSerial(Left(Range("G4"), 4), Right(Range("G4"), 2), 15)
    dEnd = DateSerial(Left(Range("G7"), 4), Right(Range("G7"), 2), 15)


    '' Calendar Filter in the Pivot Tables
    Dim strCal

    strCal = "Date Entered UTC"

    On Error Resume Next
    Application.EnableEvents = False
    Application.ScreenUpdating = False


            Set shPT = ActiveWorkbook.Worksheets("PivotTables")

                For Each pt In shPT.PivotTables


                    With pt.PageFields(strCal)

                        For Each pi In .PivotItems

                            '' Loop through all year-month for each pi.
                            For d = dStart To dEnd Step 30
                                If pi.Value = Year(d) & " - " & Month(d) Then
                                    .CurrentPage = Year(d) & " - " & Month(d)
                                    Exit For
                                Else
                                    .CurrentPage = "(All)"
                                End If
                            Next d
                        Next pi
                    End With
            Next pt


    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Concerned_Citizen Concerned_Citizen · Accepted Answer · 2016-06-10T19:29:52

I found an alternative that works. Replace

For Each pt In shPT.PivotTables
           With pt.PageFields(strCal)

                    For Each pi In .PivotItems

                        '' Loop through all year-month for each pi.
                        For d = dStart To dEnd Step 30
                            If pi.Value = Year(d) & " - " & Month(d) Then
                                .CurrentPage = Year(d) & " - " & Month(d)
                                Exit For
                            Else
                                .CurrentPage = "(All)"
                            End If
                        Next d
                    Next pi
                End With
        Next pt

With

Dim i As Integer
                Dim checkDate As Date

                For Each pt In shPT.PivotTables

                    Set pf = pt.PivotFields(strCal)
                    pf.ClearAllFilters
                    pf.EnableMultiplePageItems = True

                    '' Loop through the dates in the Pivot Table.
                    For i = 1 To pf.PivotItems.Count

                        checkDate = DateSerial(Left(pf.PivotItems(i), 4), Right(pf.PivotItems(i), 2), 15)

                        '' If each date is outside the boundaries of the date intervals, then
                        '' turn them off.
                        If checkDate < dStart Or checkDate > dEnd Then
                            pf.PivotItems(i).Visible = False
                        End If
                    Next i

Chris Newman's blog has good tips on filtering multiple options in pivot tabless.

Filtering Pivot Tables by Date Interval with VBA

1 Answers