Single Selection Slicer

[DCShawn]

This is a follow-up to a thread from several years ago. The forum recommended I start a new thread. I'm using the following code (based on code from this forum) to enforce a single-select slicer. I cannot figure out why it's triggering run-time error 1004: "Application-defined or object-defined error" on the "slc.VisibleSlicerItems.Count" line. Thanks!


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

Dim bSlicerIsConnected As Boolean
Dim pvt As PivotTable
Dim slc As SlicerCache
Dim sLastUndoStackItem As String

With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
.EnableCancelKey = False
End With

' Identify target slicer
Const MySlicer As String = "Slicer_TEAM3"
Const strSubject As String = "team"

' Get undo stack and handle empty stack scenario
On Error Resume Next
sLastUndoStackItem = Application.CommandBars("Standard").FindControl(ID:=128).List(1)
On Error GoTo 0

' Verify event triggered by slicer or filter
Select Case sLastUndoStackItem
Case "Slicer Operation", "Filter"
Case vbNullString: GoTo GOODBYE ' Undo stack empty
Case Else: GoTo GOODBYE
End Select

' Confirm slicer exists
On Error Resume Next
Set slc = ActiveWorkbook.SlicerCaches(MySlicer)
On Error GoTo 0
If slc Is Nothing Then GoTo GOODBYE

' Verify pivot table that triggered event is connected to slicer
For Each pvt In slc.PivotTables
If pvt.Name = Target.Name Then bSlicerIsConnected = True: Exit For
Next pvt
If Not bSlicerIsConnected Then GoTo GOODBYE

' Determine number of selected items
If slc.VisibleSlicerItems.Count = 1 Then GoTo GOODBYE

' Display error and undo
MsgBox "You can only select one " & strSubject & "."
With Application
.EnableEvents = False
.Undo
End With

GOODBYE:

With Application
.Calculation = xlAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
.EnableCancelKey = True
End With

End Sub

 

[DCShawn]

It was disappointing to get ZERO replies on the forum. Maybe this forum isn't active anymore. Anyway, just in case someone stumbles across this, here's what I ended up with:

Sub LimitToOne(ByVal rgTargetRange As PivotTable, strSlicerName As String, ByVal strFocus As String)
' Limit slicer to one selection

On Error GoTo ERROR_HANDLER

Application.EnableEvents = False
Application.ScreenUpdating = False

Dim bSlicerIsConnected As Boolean
Dim pvt As PivotTable
Dim slc As SlicerCache
Dim sLastUndoStackItem As String

sLastUndoStackItem = Application.CommandBars("Standard").FindControl(ID:=128).List(1)

' Continue only if event was triggered by slicer or filter
' Exit if triggered by any other pivot operation

' Check undo stack to verify event was triggered by slicer or filter
Select Case sLastUndoStackItem
Case vbNullString ' Undo stack empty; do nothing
Case "Slicer Operation", "Filter" ' Continue processing

' Get slicer index
For Each slc In ActiveWorkbook.SlicerCaches
If slc.Name = strSlicerName Then Set slc = ActiveWorkbook.SlicerCaches(slc.Index): Exit For
Next slc

If Not slc Is Nothing Then

' Validate that the pivot table that triggered the event is connected to specified slicer
For Each pvt In slc.PivotTables
If pvt.Name = rgTargetRange.Name Then bSlicerIsConnected = True: Exit For
Next pvt

' Check how many slicer items are selected
' Cancel if more than one

Dim slcrCL As SlicerCacheLevel
Dim si As SlicerItem
Dim iSelected As Integer

If bSlicerIsConnected Then
For Each slcrCL In ActiveWorkbook.SlicerCaches(slc.Index).SlicerCacheLevels
For Each si In slcrCL.SlicerItems
If si.Selected Then iSelected = iSelected + 1
Next
Next

If iSelected > 1 Then
Dim vbMsg As VbMsgBoxResult
vbMsg = MsgBox("It is recommended that this report be limited to one " & strFocus & _
" at a time (you currently have " & iSelected & " selected)." & _
vbNewLine & vbNewLine & _
"Would you liked to undo the previous action?", _
vbQuestion, vbYesNo, vbDefaultButton1, "Set Scope")
If vbMsg = vbYes Then
With Application
.EnableEvents = False
.Undo
End With
End If
End If
End If
End If

Case Else ' A trigger other than slicer or filter; do nothing
End Select

GoTo GOODBYE

ERROR_HANDLER:

MsgBox Err.Number & " | " & Err.Description

GOODBYE:

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

GOTCHA

You have to UNCHECK "Hide items with no data" for any higher-level slicer. For example, if you have two slicers, COUNTRY and STATE, then the COUNTRY slicer must show items with no data. Here's why. The choice of COUNTRY (slicer 1) determines the selection the STATES (slicer 2). If you force the user to select exactly one STATE, then the COUNTRY slicer is immediately filtered to show only the country to which that state belongs. They can never pick a different country.