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

 

[Jerry Sullivan]

Michael,

No worries on not getting this sorted out on the first pass - this is a more difficult than usual question.

Let start by getting the OLAP filter to work for one field of an OLAP PivotTable. Once that is working, you can add incrementally add additional fields, multiple pivot tables, and handle the combination of OLAP and non-OLAP Pivots.

First, make a copy of your workbook and delete your existing Worksheet_Change event code.

Next, start the macro-recorder, then manually filter one field of one of your OLAP Pivots. Filter the field to show 3 only PivotItems.

Please post the recorded code and we'll use that to adapt the code example I referenced.

btw, In the code example you posted in #16, you have an On Error Resume Next statement at the beginning of the code that sets that error handler for the rest of the procedure. That's not a good approach to error handling and it makes debugging more difficult because it continues execution after unexpected errors occur.

 

[EhhMikey]

Hi Jerry, thank you so much for your effort on this!! I greatly appreciate it!

Sub Macro1()'
' Macro1 Macro
'


'


    ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "[Business Unit].[BusinessUnit by Channel].[PricingChannel]").VisibleItemsList _
        = Array("[Business Unit].[BusinessUnit by Channel].[PricingChannel].&[SBD]", _
        "[Business Unit].[BusinessUnit by Channel].[PricingChannel].&[Retail]", _
        "[Business Unit].[BusinessUnit by Channel].[PricingChannel].&[Advantage]")
    ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "[Business Unit].[BusinessUnit by Channel].[BusinessUnit]").VisibleItemsList = _
        Array("")
End Sub

 

[Jerry Sullivan]

Michael,

Here's some code for the first step filtering on field on one pivot table. Follow the insructions below in a copy of your original workbook.

First delete any exiting code you have in the workbook including the Worksheet_Change code.

Then paste this code into a standard code module. There's two procedures that I've copied from the referenced thread. The only edits I've made to those examples are in Blue font.

Private Function sOLAP_FilterByItemList(ByVal pvf As PivotField, _
   ByVal vItemsToBeVisible As Variant, _
   ByVal sItemPattern As String) As String

'--filters an OLAP pivotTable to display a list of items,
'    where some of the items might not exist
'--works by testing whether each pivotitem exists, then building an
'    array of existing items to be used with the VisibleItemsList property
'--requires Excel 2007 or later

'--Input Parameters:
'  pvf                pivotfield object to be filtered
'  vItemsToBeVisible  array of strings representing items to be visible
'  sItemPattern       string that has MDX pattern of pivotItem reference
'                     where the text "ThisItem" will be replaced by each
'                     item in vItemsToBeVisible to make pivotItem references.
'                     e.g.: "[tblSales].[product_name].&[ThisItem]"
   
 Dim lFilterItemCount As Long, lNdx As Long
 Dim vFilterArray As Variant
 Dim vSaveVisibleItemsList As Variant
 Dim sReturnMsg As String, sPivotItemName As String
 
 '--store existing visible items
 vSaveVisibleItemsList = pvf.VisibleItemsList
 
 If Not (IsArray(vItemsToBeVisible)) Then _
   vItemsToBeVisible = Array(vItemsToBeVisible)
 ReDim vFilterArray(1 To _
   UBound(vItemsToBeVisible) - LBound(vItemsToBeVisible) + 1)
 pvf.Parent.ManualUpdate = True
 
 '--check if pivotitem exists then build array of items that exist
 For lNdx = LBound(vItemsToBeVisible) To UBound(vItemsToBeVisible)
   '--create MDX format pivotItem reference by substituting item into pattern
   sPivotItemName = Replace(sItemPattern, "ThisItem", vItemsToBeVisible(lNdx))
   
   '--attempt to make specified item the only visible item
   On Error Resume Next
   pvf.VisibleItemsList = Array(sPivotItemName)
   On Error GoTo 0
   
   '--if item doesn't exist in field, this will be false
   If LCase$(sPivotItemName) = LCase$(pvf.VisibleItemsList(1)) Then
      lFilterItemCount = lFilterItemCount + 1
      vFilterArray(lFilterItemCount) = sPivotItemName
   End If
 Next lNdx
 
 '--if at least one existing item found, filter pivot using array
 If lFilterItemCount > 0 Then
   ReDim Preserve vFilterArray(1 To lFilterItemCount)
   pvf.VisibleItemsList = vFilterArray
 Else
   sReturnMsg = "No matching items found."
   pvf.VisibleItemsList = vSaveVisibleItemsList
 End If
 pvf.Parent.ManualUpdate = False

 sOLAP_FilterByItemList = sReturnMsg
End Function

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( _
   [COLOR="#0000CD"]ActiveSheet[/COLOR].ListObjects("tblVisibleItemsList").DataBodyRange.Value)

 Set pvt = [COLOR="#0000CD"]ActiveSheet.PivotTables("PivotTable1")[/COLOR]
 '--call function
 sErrMsg = sOLAP_FilterByItemList( _
   pvf:=pvt.PivotFields("[Business Unit].[BusinessUnit by Channel].[PricingChannel]"), _
   vItemsToBeVisible:=vItemsToBeVisible, _
   sItemPattern:="[COLOR="#0000CD"][Business Unit].[BusinessUnit by Channel].[PricingChannel][/COLOR].&[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

The code assumes that the ActiveSheet has an Excel Table named tblVisibleItemsList and a PivotTable named PivotTable1.
The Excel Table should be only one column wide, and be populated with the names of a few PivotItems like "SBD", "Retail", "Advantage".

That's it for the setup. Try running the macro CallingExample from the macro list.

 

[EhhMikey]

Hi Jerry,

Thank you again. I've tried the new code and am receiving the error message: 1004 “Application-defined or Object-defined error”. I did some reading and it says it may be on the wrong module so I tried the code on the worksheet module and a standard module and received the same error on both. I also tried to unlock the cells in the Trust Center - Protected view. I've very sure the table has been named correctly "tblVisibleItemsList" and is on the Active sheet (Only sheet) and the pivot table is named "PivotTable1". Is there a way I can share a picture with you without creating a URL?

Thank you!
Michael

 

[EhhMikey]

To make sure I'm including all of the details. I opened a new excel, pulled in my Olap Cube Pivot, added only the Business unit field into the filters.

I then built a table and added the options you mentioned "SBD", "Retail", "Advantage", added the code provided in a new standard module. I ran the code and received the error: 9 - Subscript out of range. I changed the name of my table to "tblVisibleItemsList" and have been receiving the error above no matter what I try, and it doesn't highlight where the code may be off?

Thanks,
Michael

 

[Jerry Sullivan]

Michael,

To narrow down the problem, temporarily disable the error hander by putting a single quote in front of this statement in the CallingExample Sub.

' On Error GoTo ErrProc

Doing this will cause Excel to stop at and highlight the statement where the error arises.

 

[EhhMikey]

When I selected the Debug function the following was highlighted:

  pvf.VisibleItemsList = vSaveVisibleItemsList

 

[Jerry Sullivan]

What is the error message?

Also, enter this expression into the Immediate Window of the VB Editor (If the Immediate window isn't already open, use Ctrl-G to display it).

?ubound(vSaveVisibleItemsList)

 

[EhhMikey]

Its the same error message: 1004 “Application-defined or Object-defined error" I updated the Immediate Window, reran the query and had the same results. The same error message with the same highlighted section.

 

[Jerry Sullivan]

The test below will confirm that the code is finding the table.

Please copy this macro into a standard module in the same workbook. Activate the worksheet that has the table, "tblVisibleItemsList", then run the macro Test1

Sub Test1()
 Dim tbl As ListObject
   
 On Error Resume Next
 Set tbl = ActiveSheet.ListObjects("tblVisibleItemsList")
 On Error GoTo 0
 
 If tbl Is Nothing Then
   MsgBox "Table named ""tblVisibleItemsList"" not found."
 Else
   MsgBox "Table has " & tbl.Range.Rows.Count & " row(s) (incl. header) and " _
      & tbl.Range.Columns.Count & " column(s)."
 End If
 
End Sub