How to control Excel PIVOT table filters from cell values with VBA

[LarryM]

I'm trying to refresh my pivot table base on two cell values. End user will type in value in cell B4 (Region) and value in cell B5 (Department). Pivot table would refresh base on these values.

I found code below, but only allows for referencing 1 cell value. Not sure how to modify it for 2 cell values.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, 
'it only updates when cell'B4 or B5 is touched

If Intersect(Target, Range("B4:B5")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat AsString

'Amend here to filter your data
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Region")
NewCat = Worksheets("Sheet1").Range("B4").Value

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

EndSub

 

[prasaddn]

Hi

Appreciate if you can upload a your sample file.

I could not try this myself as I was not having time to create dummy data, but just thinking if this could solve.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, 'it only updates when cell'B4 or B5 is touched
If Intersect(Target, Range("B4:B5")) Is Nothing Then Exit Sub

'Set the Variables to be usedDim pt As PivotTable
Dim FieldRegion As PivotField
Dim FieldDept As PivotField
Dim NewRegion As String
Dim NewDept As String

'Amend here to filter your dataSet pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set FieldRegion = pt.PivotFields("Region")
Set FieldDept = pt.PivotFields("Department")
NewRegion = Worksheets("Sheet1").Range("B4").Value
NewDept = Worksheets("Sheet1").Range("B5").value

'This updates and refreshes the PIVOT tableWith pt
FieldRegion.ClearAllFilters
FieldRegion.CurrentPage = NewRegion
FieldDept.ClearAllFilters
FieldDept.CurrentPage = NewDept
pt.RefreshTable
EndWith

EndSub

Please let me know if this works.

Regards,
Prasad DN

 

[prasaddn]

In the above code, some part of the coding as gone under comment part. kindly make changes as mentioned below:
'Set the Variables to be used
Dim pt As PivotTable

And in
'This updates and refreshes the PIVOT table
With pt

Regret if any inconvenience caused. I could not edit it to correct my post. hence adding this reply.

Regards,
Prasad DN

 

[LarryM]

Hi

Appreciate if you can upload a your sample file.

I could not try this myself as I was not having time to create dummy data, but just thinking if this could solve.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, 'it only updates when cell'B4 or B5 is touched
If Intersect(Target, Range("B4:B5")) Is Nothing Then Exit Sub

'Set the Variables to be usedDim pt As PivotTable
Dim FieldRegion As PivotField
Dim FieldDept As PivotField
Dim NewRegion As String
Dim NewDept As String

'Amend here to filter your dataSet pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set FieldRegion = pt.PivotFields("Region")
Set FieldDept = pt.PivotFields("Department")
NewRegion = Worksheets("Sheet1").Range("B4").Value
NewDept = Worksheets("Sheet1").Range("B5").value

'This updates and refreshes the PIVOT tableWith pt
FieldRegion.ClearAllFilters
FieldRegion.CurrentPage = NewRegion
FieldDept.ClearAllFilters
FieldDept.CurrentPage = NewDept
pt.RefreshTable
EndWith

EndSub

Please let me know if this works.

Regards,
Prasad DN

I've attached my sample file with your code included in it. It does not seem to be running. any help is greatly appreciated.

 

[prasaddn]

Hi,

I guess in the code "t" is missing when you typed "Ref by Dept".
Issue line:

Set FieldDept = pt.PivotFields("Ref by Dep")
'change this to
 
Set FieldDept = pt.PivotFields("Ref by Dept")

Regards,
Prasad DN
PS: its working when I did the above changes.

 

[LarryM]

Thank you for your help. The code works great.