using VBA to filter a pivot table based on a cells value

[JoeyH]

Hello, I have been searching for hours trying to get this code to work. I am trying to get a pivot table to filter based on the value within a specific cell that will change often. When using the code below I get a run-time error '1004': "unable to set the currentPage property of the PivotField class". I have tried a few things I have found online with no luck. Any and all help is greatly appreciated.

--------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

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

Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String

Set pt = Worksheets("DATA_SOURCE").PivotTables("TESTING")
Set Field = pt.PivotFields("[Table2].[ID #].[ID #]")

NewCat = Worksheets("DATA_SOURCE").Range("G41").Value

With Field
.ClearAllFilters
.CurrentPage = NewCat
pt.RefreshTable
End With

End Sub

 

[DanteAmor]

Try another option
Note: Before testing, update the pivot table values.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.CountLarge > 1 Then Exit Sub
  If Intersect(Target, Range("G41")) Is Nothing Then Exit Sub
  Application.ScreenUpdating = False
  With ActiveSheet.PivotTables("TESTING").PivotFields("[Table2].[ID #].[ID #]")
    .ClearAllFilters
    .CurrentPage = Target.Value
  End With
End Sub

 

[JoeyH]

Hello @JoeyH, give this a try.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim pTable As PivotTable
  Dim pField As PivotField
  Dim pItem As PivotItem
  Dim n As Long
 
  Dim Target As Range
  Set Target = Range("G41")
 
  If Target.CountLarge > 1 Then Exit Sub
  If Intersect(Target, Range("G41")) Is Nothing Then Exit Sub
 
  Application.ScreenUpdating = False
 
  Set pTable = Worksheets("DATA_SOURCE").PivotTables("TESTING")
  Set pField = pTable.PivotFields("[Table2].[ID #].[ID #]")
   
   pField.ClearAllFilters

   On Error Resume Next
       pField.CurrentPageName = "[Table2].[ID #].&[" & Range("G41") & "]"
   On Error GoTo 0
   
End Sub

Unfortinulatly this did not work either.

 

[DanteAmor]

Did you try post #11?
you can share your book on google drive or dropbox.

 

[Alex Blakenburg]

I was also waiting until you replied to Dante's post #11. "This did not work" is not exactly a lot to go on.
If @DanteAmor's option doesn't work then sharing the workbook as he suggested would be ideal, we don't need a lot of actual data but a few unedited ID numbers would be good to leave in the table.

Since we seem to be in a different time zone and to keep it moving:-

• I had to change Dante's .CurrentPage line to the below to make it work on my test data.
  .CurrentPageName = "[Table2].[ID #].&[" & Target.Value & "]"
• Is your code in the Code page of the Sheet "DATA_SOURCE" ?
• Please confirm G41 and the Pivot are both on the sheet DATA_SOURCE
• In post #6 you refer to E41, does E41 have any relevance or can we ignore that ?
• What does not work mean when you tried my code ? Did you get a VBA error or did it not do anything ?
  Same for when you tried post #11.
• Is G41 part of a merged cell ?

If you force it manually is at least one of the formulas I have here TRUE.

20220213 VBA Pivot Table Filter.xlsm
	E	F	G	H	I	J	K
39
40					=G41=H43	=""&G41=""&H43
41	Filter Value		111111		FALSE	TRUE
42
43			ID #	111111
44
45			Sum of AMOUNT
46			CATERGORY	Total
47			COG	10
48			Grand Total	10
49
DATA_SOURCE

Cell Formulas
Range	Formula
I40:J40	I40	=FORMULATEXT(I41)
I41	I41	=G41=H43
J41	J41	=""&G41=""&H43