Pivot Report Filter for two non-contiguous date ranges (Excel 2010 VBA)

[mramazan]

Hi, my question addressed to Jerry Sullivan but reply from anyone is welcome.

I have to filter my pivot table based on "date" field using Report Filter method for two different date ranges i.e. between 01/09/2015, 27/09/2015 and between 01/09/2016, 27/09/2016 (non-contiguous). I want to use it for comparison of current year dates with last year same dates.

I searched and found an excellent solution in this link:

http://www.mrexcel.com/forum/excel-...ic-applications-excel-2010-a.html#post3438811

It works fine for one contiguous range. Below is my adaptation of code:

Sub Test_Filter_Date_Range()
    Dim dtFrom As Date, dtTo As Date
    Dim pt As PivotTable


    With ActiveSheet
        Set pt = Worksheets("Dashboard").PivotTables("PT1")
        dtFrom = [DateFrom_name].Text
        dtTo = [DateTo_name].Text
    End With


    pt.ClearAllFilters
    Call Filter_PivotField_by_Date_Range(pt.PivotFields("Date"), dtFrom, dtTo)
End Sub


Public Function Filter_PivotField_by_Date_Range(pvtField As PivotField, dtFrom As Date, dtTo As Date)
    Dim bTemp As Boolean, i As Long
    Dim dtTemp As Date, sItem1 As String


    With pvtField
        Debug.Print "Finding first date meeting criteria..."
        For i = 1 To .PivotItems.Count
            On Error Resume Next
            dtTemp = .PivotItems(i)
            If Err.Number <> 0 Then
                Debug.Print .PivotItems(i) & " is not a valid date item"
                On Error GoTo 0
            Else
                bTemp = (dtTemp >= dtFrom) And _
                    (dtTemp <= dtTo)
                If bTemp Then
                    sItem1 = .PivotItems(i)
                    Exit For
                End If
            End If
        Next i
        On Error GoTo 0
        If sItem1 = "" Then
            MsgBox "No items are within the specified dates."
            Exit Function
        End If


        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual


       .Parent.ManualUpdate = True


        Debug.Print "Filtering to show items between dates..."
 
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
        .PivotItems(sItem1).Visible = True
        For i = 1 To .PivotItems.Count
            On Error Resume Next
            dtTemp = .PivotItems(i)
            If Err.Number <> 0 Then
                On Error GoTo 0
                Debug.Print .PivotItems(i) & " is not a valid date item"
                .PivotItems(i).Visible = False
            Else
                Debug.Print .PivotItems(i) & ": " _
                    & IIf((dtTemp >= dtFrom) And (dtTemp <= dtTo), "Show", "Hide")




                If .PivotItems(i).Visible <> _
                    ((dtTemp >= dtFrom) And (dtTemp <= dtTo)) Then
                        .PivotItems(i).Visible = Not .PivotItems(i).Visible
                End If
            End If
        Next i
        On Error GoTo 0
    End With


    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

My question is how can I modify function for two ranges like this:

Sub Test_Filter_Date_Range()
    Dim dtFrom1 As Date, dtTo1 As Date
    Dim dtFrom2 As Date, dtTo2 As Date
    Dim pt As PivotTable


    With ActiveSheet
        Set pt = Worksheets("Dashboard").PivotTables("PT1")
        dtFrom1 = [DateFrom1_name].Text
        dtTo1 = [DateTo1_name].Text
        dtFrom2 = [DateFrom2_name].Text
        dtTo2 = [DateTo2_name].Text


    End With


    pt.ClearAllFilters
    Call Filter_PivotField_by_Date_Range(pt.PivotFields("Date"), dtFrom1, dtTo1, dtFrom2, dtTo2)
End Sub


Public Function Filter_PivotField_by_Date_Range(pvtField As PivotField, dtFrom1 As Date, dtTo1 As Date, dtFrom2 As Date, dtTo2 As Date)

'
'
'  modified code required
'

End Function

Kindly modify "Filter_PivotField_by_Date_Range" function to implement this requirement.