简体   繁体   中英

Control Filters of Excel Pivot Tables from Cell Values with VBA

I am trying to refresh my powerpivot pivot table based on two cell values. End user will use drop down list in cell C17 and C18 to derive a value in cell G17 and G18 (through some excel calculation). Pivot Table will refresh based on Cell G17 and G18.

I have scripted the code as follow, but it doesn't seem to work as the pivot table doesn't refresh after I select a value from the drop down list in C17 and C18.

Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, Range("G17:G19")) Is Nothing Then Exit Sub

Dim pt As PivotTable
Dim FieldHr As PivotField
Dim FieldEndingMin As PivotField
Dim NewHr As String
Dim NewMin As String

Set pt = Worksheets("Calculator").PivotTables("Table1")
Set FieldHr = pt.PivotFields("Hr")
NewHr = Worksheets("Calculator").Range("G17").Value
Set FieldEndingMin = pt.PivotFields("Ending Min")
NewMin = Worksheets("Calculator").Range("G18").Value

With pt
FieldHr.ClearAllFilters
FieldHr.CurrentPage = NewHr
FieldEndingMin.ClearAllFilters
FieldEndingMin.CurrentPage = NewMin
pt.RefreshTable
End With

End Sub

I moved the code from Worksheet_SelectionChange to Worksheet_Change event.

I added a Union of Ranges, Cells C17:C18 with Cells G17:G19 (is G19 needed ? in your post you mentioned G17:G18).

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Union(Range("C17:C18"), Range("G17:G19"))) Is Nothing Then Exit Sub

Dim pt                 As PivotTable
Dim FieldHr            As PivotField
Dim FieldEndingMin     As PivotField
Dim NewHr              As String
Dim NewMin             As String

Set pt = Worksheets("Calculator").PivotTables("Table1")
Set FieldHr = pt.PivotFields("Hr")
NewHr = Worksheets("Calculator").Range("G17").Value
Set FieldEndingMin = pt.PivotFields("Ending Min")
NewMin = Worksheets("Calculator").Range("G18").Value

With FieldHr
    .ClearAllFilters
    .CurrentPage = NewHr
End With

With FieldEndingMin
    .ClearAllFilters
    .CurrentPage = NewMin
End With

pt.RefreshTable

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM