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

 

[EhhMikey]

Thank you Jerry,

I tested and my second pivot (PivotTable2) is just a standard pivot table. Will it be possible to integrate code from the OLAP pivot AND code from the regular pivot so the "tblVisibleItemsList"? I will take a look at both and see if I can work through it on my own and advise if I'm able to figure it out. Please advise when you have time!

-Michael

 

[EhhMikey]

To clarify, I was able to get both codes working!! The code in Post 5 updates automatically any time I change the range and the OLAP pivot updates when I fire the pivot.

How would I get the OLAP pivot to filter similar to the Post 5? Knowing the sheet and the code, I know the pivot won't update until I fire the Macro, ideally this would work automatically for both pivots so the User wouldn't have to fire the code themselves.

My workbook is coming together brilliantly, I'm just hoping to add some final things to improve the UX. The last thing would be in reference to Post 38 (Q3), Per the table, when I select from the drop down it does not create a filter on the Pivot, i.e. only selecting Advantage. I currently have to manually add or delete the options and the filter is set on that, regardless of what values are selected on the table.

I'm sooo close!!!

 

[Jerry Sullivan]

Michael,

I agree you should use the same trigger whether the Pivot type is OLAP or Standard. The choice is yours whether you want to trigger both calls with a Worksheet_Change event or a button. The Worksheet_Change is more automatic- but the downside is that the filtering process will be run on all PivotTables each time the user makes a change to an item in the table. Depending on the size of the PivotCache, calling the filter repeatedly can be slow- in which case a button would be better.

My workbook is coming together brilliantly, I'm just hoping to add some final things to improve the UX. The last thing would be in reference to Post 38 (Q3), Per the table, when I select from the drop down it does not create a filter on the Pivot, i.e. only selecting Advantage. I currently have to manually add or delete the options and the filter is set on that, regardless of what values are selected on the table.

If I'm understanding your question, this should work as you wanted once you setup the VBA code to use either Worksheet_Change event or a button to trigger the filtering functions.

 

[neufuerVBA]

Hi all,

I´ve read the article and found that really helpful. But I wonder if I can have multiple reference cells that could change part of my pivot table. i.e. I have a reference cell, e.g. Department (HR, Marketing, Finance) and I want to see the table content according to the referential Department that I have such that all irrelevant content would not be shown up when I pick one.

For more detail, if I type HR, then only the content with, for instance, working time, vacation, can show up, while cells with costs, benefit, profit, etc., wont be.

I would really appreciate if someone can help me with that.

 

[EhhMikey]

Hi NeufuerVBA,

Are you using Cubes or just regular pivot tables? I think for non-cubes you should be able to build an array, cubes get a bit more confusing. I've been using the following for creating permanent filters

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 ws As Worksheet
 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( _
   ActiveSheet.ListObjects("NonBoss").DataBodyRange.Value)


 Set pvt = Sheets("Pivots").PivotTables("PivotTable1")
 '--call function
 sErrMsg = sOLAP_FilterByItemList( _
   pvf:=pvt.PivotFields("[Article].[Article by SPGS].[SPGS Class]"), _
   vItemsToBeVisible:=vItemsToBeVisible, _
   sItemPattern:="[Article].[Article by SPGS].[SPGS Class].&[ThisItem]")
   
 
 '--read filter items from worksheet table
 vItemsToBeVisible = Application.Transpose( _
   ActiveSheet.ListObjects("Boss").DataBodyRange.Value)


 Set pvt = Sheets("Pivots").PivotTables("PivotTable2")
 '--call function
 sErrMsg = sOLAP_FilterByItemList( _
   pvf:=pvt.PivotFields("[Article].[Article by SPGS].[SPGS Class]"), _
   vItemsToBeVisible:=vItemsToBeVisible, _
   sItemPattern:="[Article].[Article by SPGS].[SPGS Class].&[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

This provides me filters on the lists I want (on separate pivot tables) since my lists are huge and would take too long to individually select each option.

For creating a drop down to select between the lists of filters, which I think is what you are looking for, I'm not really sure. Jerry has been extremely helpful and may be able to assist.

Regards,
Michael

 

[Anirudh4891]

Hi Jerry,

I have a similar request. I have read through your post on the filter selection based on multiple value fields but the code terminates when I give the range of the fields which contain the values to be selected.

Kindly assist as I am not much knowledgeable with macro programming.

Regards

 

[Anirudh4891]

Sub SelectionChange()
'This line stops the worksheet updating on every change, it only updates when cell
'H6 or H7 is touched
If Intersect(Target, Range("M6:U34")) 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("Cannibalization (2)").PivotTables("PivotTable2")
Set Field = pt.PivotFields("Customer New")
NewCat = Worksheets("Cannibalization (2)").Range("M6:U34").Value

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


The above script is what I implemented and the values to be selected are within the range defined.

Any help would be much appreciated.

 

[zbyrek2]

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.

What must be change to change visible mode to unvisible?