Filtering Pivot Table Based on a Cell Value

[mkilavuz]

Dear Mr. Excel Forum Member,

I would like to use a VBA script to filter a pivot table linked to a cell value. I found below code online and try to replicate the same example that comes with this code. However, I end up with having "Run-time error 1004" which says "Unable to get the PivotFields property of the PivotTable class." and the error points out the line: Set Field = pt.PivotFields("Category").

Would you please help me to understand what would possibly cause this error and the methods to correct it?

All the best,



Private Sub Worksheet_SelectionChange(ByVal Target As Range)

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

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

'Here you amend to suit your data
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets("Sheet1").Range("H6").Value

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

End Sub

 

[jorismoerings]

Hi,

This VBA should work but only if:
1. the worksheet the pivot table is placed on is called "Sheet1";
2. the pivot table name on the sheet is actualy called PivotTable1;
3. The pivot table has a field which is called "Category"
4. The value you want to filter the pivot table on is:
a. is placed in cell H6
b. is an existing value.

Hope this helps.

 

[mkilavuz]

Hi jorismoerings,

all of the conditions you've mentioned above are satisfied. Still no luck. Any additional opinion will be high appreciated.

Best,

 

[jorismoerings]

Could you share your workbook somehow so I can take a look!

 

[mkilavuz]

Thanks for your quick reply jorismoerings,

I exactly replicated below example:

All the best,

 

[jorismoerings]

Hi,

Amend your code to this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'H6 or H7 is touched
If Intersect(Target, Worksheets(1).Range("H6:H7")) Is Nothing Then Exit Sub

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

'Here you amend to suit your data
Set pt = Worksheets(1).PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets(1).Range("H6").Value

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


End Sub

This is a link to my BOX account were i have a working test model https://app.box.com/s/3s35ai3pxcks9wpr9s5ihh0uuu0vkqiw
Hope this helps

 

[mkilavuz]

Dear jorismoerings,

Your code works. I appreciate all of your effort and time.

Best Wishes,

 

[jorismoerings]

We got here in the end. Glad i could help. Thanks for the feedback.

 

[mkilavuz]

Dear jorismoerings,

Hope you are doing well. I kindly need your additional help on the above subject.

In the above example, the pivot filter is updated as NewCat variable gets a new value. However, I get an error message if the value I set NewCat is not one of the available pivot items. So, in this case, I would like the pivot filter to be set to "(blank)".

Do you mind amending your previous code based on this requirement?

All the Best,

M

 

[jorismoerings]

Hi check this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'This line stops the worksheet updating on every change, it only updates when cell
'H6 or H7 is touched
If Intersect(Target, Worksheets(1).Range("H6:H7")) Is Nothing Then Exit Sub

'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim pivot_item As PivotItem
Dim NewCat As String
Dim test_val As String

'Here you amend to suit your data
Set pt = Worksheets(1).PivotTables("PivotTable1")
Set Field = pt.PivotFields("Category")
NewCat = Worksheets(1).Range("H6").Value

'Here is the test if the input field exists
test_val = NewCat
For Each pivot_item In pt.PivotFields("Category").PivotItems
    If pivot_item.Name = test_val Then
        Exit For
    End If
Next pivot_item
On Error Resume Next

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

End Sub