VBA - Loop through each visible slicer item

Seba Robles

Board Regular
Joined
May 16, 2018
Messages
71
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hello,

I'm trying to loop through all visible slicer items so that I can then copy the updated pivot table based on that slicer selection.

The code below sort of works, it's just not looping through each item on the slicer one by one.

Instead it selects them all and starts by removing one by one. Let's say there are 5 active slicer items, the code currently starts by showing all 5 items, then it shows 4, then 3, etc.

I want to select the first slicer item alone, then the second slicer item by itself, and so on.

Any help is greatly appreciated!!

VBA Code:
Sub SlicerTest()

    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache

    Set slBox = ActiveWorkbook.SlicerCaches("Slicer_Owner")

    'loop through each slicer item
    For Each slItem In slBox.SlicerItems

        'show all items to start
        slBox.ClearManualFilter

        'test each item against itself
        For Each slDummy In slBox.SlicerItems

            'if the item equals the item in the first loop, then select it
            'otherwise don't show it (thus showing 1 at a time between the nested loops)
            If slItem.Name = slDummy.Name Then slDummy.Selected = True Else: slDummy.Selected = False

    'copy table
    Range("A5", Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Copy

        Next slDummy

    Next slItem

End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Simply move those 2 lines of code that copies your pivot table outside the the inner For Each/Next loop...

VBA Code:
    'loop through each slicer item
    For Each slItem In slBox.SlicerItems

        'show all items to start
        slBox.ClearManualFilter

        'test each item against itself
        For Each slDummy In slBox.SlicerItems

            'if the item equals the item in the first loop, then select it
            'otherwise don't show it (thus showing 1 at a time between the nested loops)
            If slItem.Name = slDummy.Name Then slDummy.Selected = True Else: slDummy.Selected = False

        Next slDummy

        'copy table
        Range("A5", Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Copy

    Next slItem

By the way, you can replace...

VBA Code:
        'copy table
        Range("A5", Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Copy

with

VBA Code:
slBox.PivotTables(1).TableRange1.Copy

or

VBA Code:
slBox.PivotTables("PivotTable1").TableRange1.Copy

Note, however, to include page fields, replace TableRange1 with TableRange2.

Hope this helps!
 
Upvote 0
Awesome, so I'm almost there.

The only problem now is that the code is looping through the hidden slicer items with no data. Any idea why this happens and how I could avoid that?
 
Upvote 0
Prior to looping through each slicer item, set the MissingItemsLimit property of the PivotCache object to xlMissingItemsNone, and refresh...

VBA Code:
Sub SlicerTest()

    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache

    Set slBox = ActiveWorkbook.SlicerCaches("Slicer_Owner")

    With slBox.PivotTables(1).PivotCache
        .MissingItemsLimit = xlMissingItemsNone
        .Refresh
    End With

    'loop through each slicer item
    For Each slItem In slBox.SlicerItems

        'show all items to start
        slBox.ClearManualFilter

        'test each item against itself
        For Each slDummy In slBox.SlicerItems

            'if the item equals the item in the first loop, then select it
            'otherwise don't show it (thus showing 1 at a time between the nested loops)
            If slItem.Name = slDummy.Name Then slDummy.Selected = True Else: slDummy.Selected = False

        Next slDummy

        'copy table
        slBox.PivotTables(1).TableRange1.Copy

    Next slItem
    
End Sub
 
Upvote 0
Hmm it still doesn't work.... it keep looping through the hidden slicer items, or rather the slicer items with no data.

I tried using slBox.VisibleSlicerItems but that also did not work...

And I tried the following IF statement but I couldn't get it to work. I get a compile error saying 'Next without For'

VBA Code:
Sub SlicerTest3()

    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache

    Set slBox = ActiveWorkbook.SlicerCaches("Slicer_Owner")

    'loop through each slicer item
    For Each slItem In slBox.SlicerItems

        'show all items to start
        slBox.ClearManualFilter

        'test each item against itself
        For Each slDummy In slBox.SlicerItems

            'if the item equals the item in the first loop, then select it
            'otherwise don't show it (thus showing 1 at a time between the nested loops)
            If slItem.Name = slDummy.Name Then slDummy.Selected = True Else: slDummy.Selected = False

        Next slDummy

        If CountA.CountA.slBox.PivotTables(1).TableRange1 > 15 Then
        
        'copy table
        slBox.PivotTables(1).TableRange1.Copy
        Sheets.Add After:=ActiveSheet
        ActiveSheet.Paste

       'return to previous sheet
        Sheets("Sheet1").Select
        Sheets("Sheet1").Activate
        
        Else 'do nothing

    Next slItem
    
End Sub
 
Upvote 0
In the code that I posted, I'm referring to the pivot table by index number, instead of pivot table name. Maybe it's referring to the wrong pivot table? Do you have more than one pivot table? If so, try referring to it by name instead (ie. With slBox.PivotTables("PivotTable1").PivotCache).
 
Upvote 0
I copy/pasted your code and referred to the pivot table by its name and no luck D:
 
Upvote 0
Just to be sure, can you please post the exact code that you're trying?
 
Upvote 0
At the end of the code, where it copies the table based on the slicer selection and pastes it into a new sheet, after the slicer items with data are pasted, the code keeps creating new sheets and pasting only the header row of the table... which is why I assume it keeps looping through the hidden slicer items with no data.

Also, after your comment on the pivot table names, I have another slicer on another sheet that has the caption "Owner" but the slicer name is different to the one we're referencing here. Not sure if that helps.

Here's the code

VBA Code:
Sub SlicerTest()

    Dim slItem As SlicerItem, slDummy As SlicerItem
    Dim slBox As SlicerCache

    Set slBox = ActiveWorkbook.SlicerCaches("Slicer_Owner")

    With slBox.PivotTables("pt_Email").PivotCache
        .MissingItemsLimit = xlMissingItemsNone
        .Refresh
    End With

    'loop through each slicer item
    For Each slItem In slBox.SlicerItems

        'show all items to start
        slBox.ClearManualFilter

        'test each item against itself
        For Each slDummy In slBox.SlicerItems

            'if the item equals the item in the first loop, then select it
            'otherwise don't show it (thus showing 1 at a time between the nested loops)
            If slItem.Name = slDummy.Name Then slDummy.Selected = True Else: slDummy.Selected = False

        Next slDummy

            'copy table
            slBox.PivotTables("pt_Email").TableRange1.Copy
            Sheets.Add After:=ActiveSheet
            ActiveSheet.Paste
    
            Sheets("Email List").Select
            Sheets("Email List").Activate

    Next slItem
 
Upvote 0
The code looks fine. If the right slicer cache and pivot table are being reference, it should clear the old items, etc. Right-click the slicer, select Slicer Settings, and make sure you're referring to the correct cache. Same thing for the pivot table. Right-click the slicer, select Report Connections, and check whether the correct pivot table is connected.

I'm logging off now, so if there's anything else, I'll look at it in the morning.

Cheers!
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top