Filter pivot table off multiple reference cells?

[SURFER349]

So there's this tutorial to use a single cell
How to control Excel PIVOT tables from a cell value with VBA | Dedicated Excel

But what if I want to have multiple items filtering the pivot table? The below script is what I currently have. What if I want to use 2 different user inputs to filter the PivotTable by 2 values (the same as selecting two from the filter drop-down).?





Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'This line stops the worksheet updating on every change, it only updates when cell
'A2 through A5 is touched
If Intersect(Target, Range("A2:A5")) 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("Tab that contains PivotTable").PivotTables("PivotTable1")
Set Field = pt.PivotFields("FilterColumnName")
NewCat = Worksheets("Tab that contains PivotTable").Range("A3").Value

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

End Sub

 

[SURFER349]

This has been working great! I'm looking for a slightly different twist to this....can you help me figure this out?

So what if I have a single Pivot Table with multiple Filter Fields to set? I can't seem to set up a generic VBA code for this.

Goal: User types in filter values into main page reference cells. FilterField1 in cell A2. FilterField2 in cell B2, etc.
The PivotTable then sets the filters to only those user inputs, with all others unchecked.

What do you think?

 

[wilfem]

I've modified the code to handle either a vertical or horizontal list. Please replace the previous Worksheet_Change code with this. (the procedures in the Standard Code module don't need to be changed).

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rFilterInput As Range
 Dim sErrMsg As String
 Dim vVisibleItems As Variant
 Dim wksPivots As Worksheet
 
 '-check if changed cell(s) are within pivotitem input range
 Set rFilterInput = Range("A2:A4") 'can be one column vertical range OR
 
 Set rFilterInput = Range("A2:C2") 'one-row horizontal range

 If Intersect(Target, rFilterInput) Is Nothing Then GoTo ExitProc
 
 On Error GoTo ErrProc
 With Application
   .EnableCancelKey = xlErrorHandler
   .EnableEvents = False
   If rFilterInput.Columns.Count = 1 Then
      vVisibleItems = .Transpose(rFilterInput.Value)
   ElseIf rFilterInput.Rows.Count = 1 Then
      vVisibleItems = .Transpose(.Transpose(rFilterInput.Value))
   Else
      sErrMsg = "Filter item range must be one column or one row."
      GoTo ExitProc
   End If
 End With
 '--identify sheet with pivottable
 Set wksPivots = ThisWorkbook.Sheets("Tab that contains PivotTable")
 
 '--call sub to filter pivot based on user inputs
 Call FilterPivotField( _
   pvf:=wksPivots.PivotTables("PivotTable1").PivotFields("FilterColumnName"), _
   vVisibleItems:=vVisibleItems)
  
ExitProc:
 On Error Resume Next
 Application.EnableEvents = True
 If Len(sErrMsg) Then MsgBox sErrMsg
 Exit Sub

ErrProc:
 sErrMsg = Err.Number & ": " & Err.Description
 Resume ExitProc

End Sub

I had disabled the error handling in my Post #5 code. That is likely the reason that your events were not reset when you encountered an error. This code above has the error handling enabled.

This code works but it does not clear all filter first before it filters another transaction.. Old references for filter remains even though you change the reference cells to filter. Any solution?

 

[EhhMikey]

Hi Jerry,

I've been reading through this post since the original and was hoping you could take a look at my coding as there seems to be a small mistake preventing both of my pivot tables from updating:

I'm to update two pivot tables based on updating one cell, one has standard excel data, and it's working, the other is leveraging an OLAP cube and I can't get it to recognize the tField or Target.Value I'm trying to get to. The code for the Macro is here: https://www.mrexcel.com/forum/excel-questions/596418-pivot-table-data-validation.html

It appears to be working fine, here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sField As String, sDV_Address As String
Dim tField As String, tDV_Address As String

sField = "Country" 'Field Name
sDV_Address = "$P$2" 'Cell with DV dropdown to select filter item.
tField = "[Business Unit].[Country].[Country]" 'Field Name
tDV_Address = "$P$2" 'Cell with DV dropdown to select filter item.

With ActiveSheet
If Intersect(Target, Range(sDV_Address & "," & tDV_Address)) _
Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

On Error GoTo CleanUp
Application.EnableEvents = False

Call Filter_PivotField( _
pvtField:=.PivotTables("PivotTable1").PivotFields(sField), _
vItems:=Target.Value)
Call Filter_PivotField( _
pvtField:=.PivotTables("PivotTable2").PivotFields(tField), _
vItems:=Target.Value)

End With

CleanUp:
Application.EnableEvents = True
End Sub


The first command works perfectly, the second does not but does trigger the "None of filter list items found" Msg box. I think this is due to the hiearchy issues on the OLAP pivot. If I update the pivot with a macro this is the code:

Sub Macro1()
'
' Macro1 Macro
'


'
ActiveSheet.PivotTables("PivotTable2").PivotFields( _
"[Business Unit].[Country].[Country]").ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields( _
"[Business Unit].[Country].[Country]").CurrentPageName = _
"[Business Unit].[Country].&[NETHERLANDS]"
End Sub

I've interchanged "[Business Unit].[Country].[Country]", "[Business Unit].[Country].&[NETHERLANDS]", "[Business Unit].[Country].&[Target.Value]" six ways to Sunday but nothing seems to be working.

Any ideas?

Thanks!!!

 

[Jerry Sullivan]

Hi EhhMikey,

PivotTables with OLAP data sources need to be handled differently. Try adapting the code shown in this thread.

https://www.mrexcel.com/forum/excel-questions/991823-olap-visual-basic-applications-filter.html

 

[EhhMikey]

Perfect, that code looks like what I will need. How would you recommend combining the OLAP data with the Non-Olap data? Would you write two completely separate Private Sub Worksheets, then two separate calls? The solution being that I would like to have both of the data sets on the same page and updated together.

Thank you for the OLAP code!

 

[EhhMikey]

Hi, Quick update. I was able to generate something of a work around. Could be useful for future reference for someone reading this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField

Const strField As String = "[Business Unit].[Country].[Country]"
Const stpField As String = "Country"

On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False


If Target.Address = "$P$2" Then
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables

' Analysis Services cube filter
pt.PageFields(strField).ClearAllFilters
pt.PageFields(strField).CubeField.EnableMultiplePageItems = False
If UCase(Target.Value) = "ALL" Then
pt.PageFields(strField).CurrentPageName = "[Business Unit].[Country].[All]"
Else
pt.PageFields(strField).CurrentPageName = "[Business Unit].[Country].&[" & Target.Value & "]"
End If

' Ordinary PivotTable filter
pt.PageFields(stpField).ClearAllFilters
pt.PageFields(stpField).EnableMultiplePageItems = False
If UCase(Target.Value) <> "ALL" Then
pt.PageFields(stpField).CurrentPage = Target.Value
End If

Next pt


Next ws
End If


Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Thanks for your help with this, the code above updates both Pivots. the first pivot is an Olap, the second is a regular pivot.

 

[EhhMikey]

Hi Jerry,

Would you know how to use VBA to perform a multiple selection based on a role up? Per the code above:

' Analysis Services cube filter
pt.PageFields(strField).ClearAllFilters
pt.PageFields(strField).CubeField.EnableMultiplePageItems = False
If UCase(Target.Value) = "ALL" Then
pt.PageFields(strField).CurrentPageName = "[Business Unit].[Country].[All]"
Else
pt.PageFields(strField).CurrentPageName = "[Business Unit].[Country].&[" & Target.Value & "]"
End If

If I select one of the fields in the Target.Address, it filters on that field (Target.Value). If I select none of them it defaults to "All". I want to create a roll up filter for two of the selections (it has four total) within the filter (i.e. "Advantage" and "SBD") and call it "Total" so when I select "Total", on that pivot table, it filters on those two items. Do you know how this would be possible?

Thank you!

 

[Jerry Sullivan]

Hi EhhMikey,

PivotItems can be Grouped, but that creates an additional PivotItem that allows summarizing data on one row. I don't think that's a good fit for your scenario.

The OLAP Pivot code that I referenced in Post #14, will allow you to filter for multiple items in a list. Try adapting that, and post your attempt if you get stuck.

btw, please use Code tags when posting VBA code to make it easier to read. To do that, select the code in your Post, then click the "#" icon in the forum editing toolbar.

 

[EhhMikey]

Hi Jerry,

Thank you for the quick response! I will take a look.

In the future I will use tag codes, thank you for providing the how to!

Michael

 

[EhhMikey]

Hi Jerry,

I'm very sorry, but seem to just be missing this. I've tried to create this table as simply as possible but I seem to be missing something... per the post on #14, I've kept the Worksheet code exactly as is. In the Module I've made the following edits:

Sub CallingExample()'--example showing call to function sOLAP_FilterByItemList


 Dim pvt As PivotTable
 Dim sErrMsg As String, sTemplate As String
 Dim vItemsToBeVisible As Variant


 On Error GoTo ErrProc
 With Application
   .EnableCancelKey = xlErrorHandler
   .ScreenUpdating = False
   .DisplayStatusBar = False
   .EnableEvents = False
 End With
   
 '--read filter items from worksheet table
 vItemsToBeVisible = Application.Transpose( _
   wksPivots.ListObjects("tblVisibleItemsList").DataBodyRange.Value)


 Set pvt = wksPivots.PivotTables("PivotTable1")
 '--call function
 sErrMsg = sOLAP_FilterByItemList( _
   pvf:=pvt.PivotFields("[Business Unit].[BusinessUnit by Channel].[PricingChannel].[PricingChannel]"), _
   vItemsToBeVisible:=vItemsToBeVisible, _
   sItemPattern:="[Business Unit].[BusinessUnit by Channel].[PricingChannel].&[ThisItem]")
 
ExitProc:
 On Error Resume Next
 With Application
   .EnableEvents = True
   .DisplayStatusBar = True
   .ScreenUpdating = True
 End With
 If Len(sErrMsg) > 0 Then MsgBox sErrMsg
 Exit Sub
 
ErrProc:
 sErrMsg = Err.Number & " - " & Err.Description
 Resume ExitProc
End Sub

I created a table on my page and named it "tblVisibleItemsList" and added two filters "Advantage" and "SBD" I've also tried creating this as a range and get the same error message

I click run and I get the following: "Compile error: Sub or Function not defined"

I'm probably far too new to pivots for something like this, but I'm not really sure I'm understanding where I'm creating a list and how that list is being called? Any help is greatfully appreciated, this will be incredibly helpful for what I'm trying to do... I've order Excel 2016 <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">VBA</acronym> and Macros