Excel VBA - Check Report Slicer Selections (Skip if ALL are selected)

Question

I need help with some VBA code. I have an AgeRange slicer and I have a working script that inserts a row, adds a timestamp, and then reports the slicer selections.

I'd like to add something to this that will SKIP the process if ALL the items in the slicer are selected (True).

Is there something that I can insert that says "If the slicer hasn't been touched (all items are true), then end sub".

Here's what I have for code so far:

Dim cache As Excel.SlicerCache
Set cache = ActiveWorkbook.SlicerCaches("Slicer_AgeRange")
Dim sItem As Excel.SlicerItem
For Each sItem In cache.SlicerItems
If sItem.Selected = True Then xAge = xAge & sItem.Name & ", "
Next sItem
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM")
Range("B1").Select
ActiveCell.FormulaR1C1 = xAge
Range("C1").Select
End Sub

Any help is greatly appreciated!

Answer 1

Using Dallas Franks solution, I ran into a 1004 issue where it was showing a method/object error. Could be because I am using PowerQuery to generate Power Pivots and immediately found that sometimes you must use slicer cache levels.

Dallas Franks solution was too good to start from the beginning so I found a way to slightly change it to use SlicerChacheLevel(s) and it works very well!

Sub clearWorksheetSlicers(ws As Worksheet)
'clears all slicers that have their shape on a specific worksheet

Dim slSlicer As Slicer
Dim slCache As SlicerCache
Dim item As SlicerItem
Dim hasUnSel As Boolean
Dim sllvl As SlicerChacheLevel

For Each slCache In ThisWorkbook.SlicerCaches
    For Each slSlicer In slCache.Slicers
        If slSlicer.Shape.Parent Is ws Then
            For Each sllvl In slCache.SlicerCacheLevels
                For Each item In sllvl.SlicerItems
                    If item.Selected = False Then
                        hasUnSel = True
                        Exit For
                    End If
                Next item
            Next sllvl
            If hasUnSel = True Then slCache.ClearManualFilter
            hasUnSel = False
        End If
    Next slSlicer
Next slCache

End Sub

Answer 2

The code in this thread by Dallas Frank looks like it should work, and all the properties explicitly called do exist but for some reason in my pivot table the SlicerItems collection is empty. I have to check each SlicerItem via

SlicerCache.SlicerCacheLevels.Item(1).SlicerItems

This replacement is not precisely what the original requestor asked but it is illustrative of the use of SlicerCacheLevel that got me where I needed to be when SlicerCache.SlicerItems turned out not to exist

Sub AllSlicersSelected(WorksheetWithPT As Worksheet)
Dim SlicerItems                 As SlicerItems
Dim SlicerItem                  As SlicerItem
Dim SlicerCaches                As SlicerCaches
Dim SlicerCache                 As SlicerCache
Dim SlicerCacheLevel            As SlicerCacheLevel
Dim Slicer                      As Slicer
Dim strSlicerItemsNotSelected   As String
Dim bHaveWhatWeNeed             As Boolean
Dim vSlicerItemsToSelect        As Variant

Set SlicerCaches = ThisWorkbook.SlicerCaches
For Each SlicerCache In SlicerCaches
    For Each Slicer In SlicerCache.Slicers
        If Slicer.Shape.Parent Is WorksheetWithPT Then
            bHaveWhatWeNeed = True
            Exit For
        End If
    Next
    If bHaveWhatWeNeed Then
        Exit For
    End If
Next

For Each SlicerCacheLevel In SlicerCache.SlicerCacheLevels
    For Each SlicerItem In SlicerCacheLevel.SlicerItems
        If Not SlicerItem.Selected Then
            strSlicerItemsNotSelected = strSlicerItemsNotSelected & Chr(0)
        End If
    Next
Next

If Len(strSlicerItemsNotSelected) > 0 Then
    vSlicerItemsToSelect = Split(Mid(strSlicerItemsNotSelected, 2), Chr(0))
    For Each SlicerItem In vSlicerItemsToSelect
        SlicerItem.Selected = True
    Next
End If

End Sub

Answer 3

This is a bit more than you asked for, but I figured I would share since I just wrote this for my own use. It clears all slicers physically located on a worksheet only if they are filtered (not all selected). For your question, the good bit is the for each item loop. and the line right after it.

Sub clearWorksheetSlicers(ws As Worksheet)
'clears all slicers that have their shape on a specific worksheet

Dim slSlicer As Slicer
Dim slCache As SlicerCache
Dim item As SlicerItem
Dim hasUnSel As Boolean

For Each slCache In ThisWorkbook.SlicerCaches
    For Each slSlicer In slCache.Slicers
        If slSlicer.Shape.Parent Is ws Then
            For Each item In slCache.SlicerItems
                If item.Selected = False Then
                    hasUnSel = True
                    Exit For
                End If
            Next item
            If hasUnSel = True Then slCache.ClearManualFilter
            hasUnSel = False
        End If
    Next slSlicer
Next slCache

End Sub

Answer 4

Nvm. I got it on my own. :)

Dim cache As Excel.SlicerCache
Dim sName As Slicers
Dim sItem As Excel.SlicerItem
Dim xSlice As String
Dim xName As String

For Each cache In ActiveWorkbook.SlicerCaches

    xName = StrConv(Replace(cache.Name,     "AgeRange", "Ages")
    xCheck = 0
    For Each sItem In cache.SlicerItems
        If sItem.Selected = False Then
            xCheck = xCheck + 1
        Else
            xCheck = xCheck
        End If
    Next sItem

    If xCheck > 0 Then
    For Each sItem In cache.SlicerItems
        If sItem.Selected = True Then
            xSlice = xSlice & sItem.Caption & ", "
        End If
    Next sItem

        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("B1").Select
        ActiveCell.FormulaR1C1 = xName & ": " & xSlice
        xSlice = ""
    End If

Next cache

    Range("A1").Select
    ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM")


End Sub