Applying code to all slicers?

spydey

Active Member
Joined
Sep 19, 2017
Messages
293
Is there a way to apply code to all slicers at once, without having to call out each slicer cache and each slicer item in each of those caches?

I have 4 slicers, each has 2 - 104 items in it.

I would like to run some code so that when all items for all caches are TRUE, then data labels are removed for the 10 pivot charts I have.

Else, if any slicer item for any slicer cache is false, then data labels are applied to all pivot charts.

All my pivot charts are on different sheets than the associated pivot tables.

Each pivot table is on its own sheet.

The slicers are on the same sheets as the charts.

I have some code that when the pivot table is updated, in this case via the slicer, then data labels are applied to the pivot charts.

Here is the code:

Code:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

    Dim sr As Series
    Dim ws As Worksheet
    Dim chtObj As ChartObject
 
    Set ws = ActiveSheet
        For Each chtObj In ws.ChartObjects
            For Each sr In chtObj.Chart.SeriesCollection
            
                sr.ApplyDataLabels
                
            Next sr
        Next chtObj
       
End Sub
But I have to have that in each sheet where a pivot table is present, so currently it is on 10 different sheets because there are 10 pivot tables, and each table is on its own sheet.

I would like to simplify this by having code to remove the data labels when all items for all caches are true, but when a change is made to a cache, have it apply the data labels to all charts.

I was thinking that maybe I should relocate my pivot tables to a single sheet, so that I have a single location to run the code for changes, etc. However, some of them are so huge that they would take up a lot of room. It just isn't rational to do it that way in my opinion.

I ran the Record Macro to see what is output when I make a single change to a slicer. This is what I got:

Code:
Sub TestingSlicer()

    With ActiveWorkbook.SlicerCaches("Slicer_Items_Type")
        .SlicerItems("Preferred").Selected = True
        .SlicerItems("Non-Preferred").Selected = False
    End With
End Sub
That particular slicer only has 2 items, as you can see. But some of the slicers have 100+ items. I really don't want to have to type out each item for each slicer cache.

Any thoughts?

Preferably, I would like a push in the right direction, a hint, a nudge, or maybe something simple that I can research, analyze, and build upon. I am not looking for a complete solution as I don't think that very "fair". I enjoy learning but sometimes I just don't know which direction to go, how to get there, or what is needed.

Thanks for reading!!

-Spydey

EDIT: I should have stated that all the pivot tables come from the same data set. Also, I have linked all slicers to all the pivot tables/charts, so that when one button is pressed in any of the slicers, it affects all the pivot tables and the charts are updated appropriately. Sorry.
 
Last edited:

spydey

Active Member
Joined
Sep 19, 2017
Messages
293
Ok, so playing around a bit, I have this code in a module. When I run it, it adds data labels to all charts as they currently are at that moment, but I have to manually run it.

Code:
Private Sub UpdateLabels()    
    Application.DisplayAlerts = False


Dim i As Integer
Dim sr As Series
Dim ws As Worksheet
Dim chtObj As ChartObject


x = Sheets.Count


For i = x To 1 Step -1
    Set ws = ActiveSheet
        For Each chtObj In ws.ChartObjects
            For Each sr In chtObj.Chart.SeriesCollection
            
                sr.ApplyDataLabels
                
            Next sr
        Next chtObj
Next i


Application.DisplayAlerts = True
    
End Sub
So I think that maybe I can adjust that to also check for the status of the slicer items in the slicer caches and then remove the data labels if all items are true ...... Then I just have to figure out how to get it to auto run when a change is made. I know how to do that for sheets, but am not sure how I am going to implement it in this particular case because I want to avoid putting it in multiple sheets.

Again, I think that it comes down being able to test for the status of all the slicer items of all the slicer caches, without having to name each item and each slicer cache.

-Spydey
 
Last edited:

spydey

Active Member
Joined
Sep 19, 2017
Messages
293
Alright!!! I got it working!!

Here is how I have it setup:

In the ThisWorkbook procedure, I have the following code:

Code:
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Object, ByVal Target As PivotTable)

Call UpdateLabels.SlicerChange


End Sub
In my UpdateLabels Module (which is Option Private Module), I have the following 3 subs:

Code:
Public Sub SlicerChange()


Dim sc As SlicerCache
Dim sl As Slicer
Dim si As SlicerItem
Dim ss As Boolean


    For Each sc In ThisWorkbook.SlicerCaches
        For Each sl In sc.Slicers
            For Each si In sc.SlicerItems
                If si.Selected = False Then
                    ss = True
                End If
            Next si
        Next sl
    Next sc
If ss = True Then
    AddDataLabels
        Else
            DeleteDataLabels


End If


End Sub
Code:
Private Sub AddDataLabels()
    
Application.DisplayAlerts = False


Dim sr As Series
Dim ws As Worksheet
Dim chtObj As ChartObject


On Error Resume Next


    For Each ws In ThisWorkbook.Worksheets
         For Each chtObj In ws.ChartObjects
            For Each sr In chtObj.Chart.SeriesCollection
                If sr.HasDataLabels = False Then
                    sr.ApplyDataLabels
                    sr.DataLabels.Position = xlLabelPositionAbove
                End If
                
                sr.DataLabels.Position = xlLabelPositionAbove
            Next sr
        Next chtObj
    Next ws
            
Application.DisplayAlerts = True
       
End Sub
Code:
Private Sub DeleteDataLabels()
    
Application.DisplayAlerts = False


Dim sr As Series
Dim ws As Worksheet
Dim chtObj As ChartObject


    For Each ws In ThisWorkbook.Worksheets
         For Each chtObj In ws.ChartObjects
            For Each sr In chtObj.Chart.SeriesCollection
                If sr.HasDataLabels = True Then
                    sr.DataLabels.Delete
                End If
            Next sr
        Next chtObj
    Next ws
            
Application.DisplayAlerts = True
       
End Sub
It seems to be working!!!

Now, how can I go about cleaning up the code to run a bit smoother, more efficiently, and not lag things down as much as it is.

Granted, I have quite a bit of data in my pivot tables and subsequent charts, so I am not sure if there is much more I can do.

I did notice though that the way I am calling the DataLabels change is per series per chartobject per chart, instead of just directly per chart.

I think that if I were to code it per chart via the 'ActiveChart.SetElement (msoElementDataLabelTop)' rather than per series per chartobject per chart, it might go a bit faster .... but I am not there yet and not 100% sure if it would really make that much of a difference.

Any ideas, thoughts, suggestions, what do you think?

-Spydey
 

Forum statistics

Threads
1,082,151
Messages
5,363,434
Members
400,737
Latest member
vipamuk

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top