EXCEL VBA按日期范围过滤数据透视表行标签

Question

Good day,

I am trying to filter a pivot table row label ("Dates") based on a date range in other cells (basically to select the date along with the past 6 days), through cell referencing ("E6:E12")

I googled a lot and found a few codes, which work great; however the code breaks randomly, not sure why

Can anyone propose an easier VBA to filter row labels based on date range

Code:

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

On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With pvtField
    .Parent.ManualUpdate = True
    For i = 1 To .PivotItems.Count
        dtTemp = .PivotItems(i)
        bTemp = (dtTemp >= dtFrom) And _
            (dtTemp <= dtTo)
        If bTemp Then
            sItem1 = .PivotItems(i)
            Exit For
        End If
    Next i
    If sItem1 = "" Then
        MsgBox "No items are within the specified dates."
        Exit Function
    End If
    If .Orientation = xlPageField Then .EnableMultiplePageItems = True
    .PivotItems(sItem1).Visible = True
    For i = 1 To .PivotItems.Count
        dtTemp = .PivotItems(i)
        If .PivotItems(i).Visible <> _
            ((dtTemp >= dtFrom) And (dtTemp <= dtTo)) Then
            .PivotItems(i).Visible = Not .PivotItems(i).Visible
        End If
    Next i
End With

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

Sub TESTUPDATE()

'Set the Variables to be used
Dim PT As PivotTable
Dim PT1 As PivotTable
Dim Field As PivotField
Dim NewCat As String

'Here you amend to suit your data
Set PT = Workbooks("KPI     Dashboard").Worksheets("Sheet1").PivotTables("TESTPIVOT")
Set PT1 = Workbooks("KPI  Dashboard").Worksheets("Sheet1").PivotTables("PivotTable2")
Set Field = PT.PivotFields("Date")
Set Field1 = PT1.PivotFields("Date")
NewCat = Workbooks("KPI Dashboard").Worksheets("Sheet1").Range("E7").Value

'This updates and refreshes the PIVOT table
With PT
Field.ClearAllFilters
Field.CurrentPage = NewCat
PT.RefreshTable
End With

'This is the actual code that applies the filter    
Dim Rng As Range
Dim PItem As PivotItem
With ActiveSheet
    Set Rng = .Range("G10:G15")
    For Each PItem In  .PivotTables("PivotTable2").RowFields("Date").PivotItems
    PItem.Visible = WorksheetFunction.CountIf(Rng, PItem.Name) > 0
    Next PItem
End With   
End Sub

I am getting error with PItem.Visible = WorksheetFunction.CountIf(Rng, PItem.Name) > 0 "Run Time Error - 1004. Unable to set the visible property of the pivotitem class"

There is another piece of code that replaces the last piece of previous code which is responsible for applying the filter; however does not work at all (ie no changes on the pivot):

Dim dtFrom As Date, dtTo As Date

With Sheets("Sheet1")
    dtFrom = .Range("E12")
    dtTo = .Range("E7")
End With

With PT1
Call Filter_PivotField_by_Date_Range( _
    PT.PivotFields("Date"), dtFrom, dtTo)
End With

Answer 1

Nevermind, the second code worked, i was ignorantly calling the incorrect pivot table in the code:

Call Filter_PivotField_by_Date_Range( _
PT.PivotFields("Date"), dtFrom, dtTo)

I simply changed PT to PT1, and voila :) Hope this helps anyone having a similar issue in the future