VBA - Loop through each visible slicer item

[Seba Robles]

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!!

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

 

[Domenic]

Simply move those 2 lines of code that copies your pivot table outside the the inner For Each/Next loop...

    '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...

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

with

slBox.PivotTables(1).TableRange1.Copy

or

slBox.PivotTables("PivotTable1").TableRange1.Copy

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

Hope this helps!

 

[Seba Robles]

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?

 

[Domenic]

Prior to looping through each slicer item, set the MissingItemsLimit property of the PivotCache object to xlMissingItemsNone, and refresh...

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

 

[Seba Robles]

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'

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

 

[Domenic]

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).

 

[Seba Robles]

I copy/pasted your code and referred to the pivot table by its name and no luck D:

 

[Domenic]

Just to be sure, can you please post the exact code that you're trying?

 

[Seba Robles]

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

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

 

[Domenic]

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!