slicers on different sources/caches

[hvi]

Dear Eileen
trust you are well

I am trying to adapt some excisting reports in 2010 with slicers. As far as I could find out we can connect slicers with pivot connections if the slicers are based on the same sources/caches
if not we better work with codes
I have tried a lot to find solutions but unfortunately I do not succeed ..

some explanation :

In my file I have pivots based on "units"(file = cumul data units ) and all related pivots I can linked with the pivotconnection
for the sheet value it does not work for the source is different(source = file cumul data value)

I tried to do as follows : I created a sheet "menu" where all the slicers as based for the "units"
and a sheet "slv" with indentical "slicers " based on "values"
I have tried the code (in this worksheet )as below but it does not work ... it would make me happy and would give me the possibilities to work with better performance in future

Code: Select all

Option Explicit

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
    Dim oSl As SlicerItem
    If Sh.Name <> ActiveSheet.Name Then Exit Sub
    If Sh.Name = "MENU" Then
        With SlicerCaches("Slicer_Division")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Division1").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        With SlicerCaches("Slicer_Category")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Category1").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        With SlicerCaches("Slicer_Material_Group2")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Material_Group21").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        With SlicerCaches("Slicer_Construction_Type\Calendar_month")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Construction_Type\Calendar_month1").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
    ElseIf Sh.Name = "slv" Then
        With SlicerCaches("Slicer_Division1")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Division").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        With SlicerCaches("Slicer_Category1")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Category").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        With SlicerCaches("Slicer_Material_Group21")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Material_Group2").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        With SlicerCaches("Slicer_Construction_Type\Calendar_month1")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Construction_Type\Calendar_month").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
    End If
End Sub

the intentions is that if we make a selection in "MENU" for division,category,constr type and materialgroup2 that it takes the same selections in slicers in sheet "slv"

[HansV]

Welcome to Eileen's Lounge!

Could you attach a small (stripped down) sample workbook? That would make it easier to investigate the code.

PS: this forum is named after/dedicated to Eileen Wharmby who sadly passed away 7 years ago, in 2004. (As a new member, you couldn't know that, of course)

[hvi]

dear Hans

thks for your reply , and sorry to hear about Eileen .
I tried to add workbook but maybe it did not work the attachment
I will add them here , there is a base file link to 2 files (unit and value )
many thks in advance for yuour willin,g to help me
have a nice evening
kindest regards
hermine
sorry Can you explain how I can attach here ? -thks

[HansV]

Hello Hermine,

See Tip: adding an attachment using the prosilver skin, it explains (with screenshots) how to attach a file. The maximum size for an attachment is 250 KB.

[hvi]

dear Hans

thks for your reply , and sorry to hear about Eileen .
I tried to add workbook but maybe it did not work the attachment
I will add them here , there is a base file link to 2 files (unit and value )
many thks in advance for yuour willin,g to help me
have a nice evening
kindest regards
hermine
sorry Can you explain how I can attach here ? -thks

[hvi]

Hello Hermine,

See Tip: adding an attachment using the prosilver skin, it explains (with screenshots) how to attach a file. The maximum size for an attachment is 250 KB.

dear Hans

thks for the info on how to attach , I think I did in the proper way yesterday and I retried already today , maybe files are to big
herewith a screenshot of file

























the intentions is that if we make a selection in "MENU" for division,category,constr type and materialgroup2 that it takes the same selections in slicers in sheet "slv"



























the intentions is that if we make a selection in "MENU" for division,category,constr type and materialgroup2 that it takes the same selections in slicers in sheet "slv"

[HansV]

You're making progress! One of the screenshots made it into your post.

For each screenshot, you have to take these actions:
- Click on "Upload Attachment".
- Click "Browse..." and select the file.
- Click "Add the file".
- Optionally, you can insert it in a specific place in your reply; if you omit this step, the file or screenshot will be placed at the end.

If you forget "Add the file", the attachment won't appear in your post.

[hvi]

hi hans

the base "unit" and "value" files are identical on structure

YEAR Ship-to Country Ship-To Party Ship-To Party Material Group Material Group Division Category Construction Type\Calendar month Units Jan
2009 Andorra 1070051 a 1844 NA SS K S
2009 Andorra 1070051 a 1987 NA S T S
2009 Andorra 1070051 a 3810 NA S B S
2009 Andorra 1070051 a 3811 NA S B S
2009 Andorra 1070051 a 3819 NA a T S
2009 Andorra 1070051 a 3863 NA a B S
2009 Andorra 1070051 a 3920 NA S B S
2009 Andorra 1070051 a 3922 NA S T S
2009 Andorra 1070051 a 3932 NA S B S
2009 Andorra 1070051 a 3973 NA S B S
2009 Andorra 1070051 a 3992 NA S T S
2009 Andorra 1070051 a 4002 NA S B S
2009 Andorra 1070051 a 4028 NA S T S
2009 Andorra 1070051 a 4137 NA S T S
2009 Andorra 1070051 a 4145 NA a T S
2009 Andorra 1070051 a 4157 NA SO O S
2009 Andorra 1070051 a 4157 NA SO O SH

[HansV]

I think I've found the problem. Your code correctly selects slicer items in the other slicer caches, but it doesn't always deselect items, because it may not be possible at that point to deselect an item. The only way I found around this is to select ALL slicer items before selecting/deselecting them the same way as on the active sheet.

See if the following (rather longish) code works for you:

Code: Select all

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
    Dim oSl As SlicerItem
    If Sh.Name <> ActiveSheet.Name Then Exit Sub
    Application.EnableEvents = False
    On Error GoTo ErrHandler
    If Sh.Name = "MENU" Then
        For Each oSl In SlicerCaches("Slicer_Division1").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Division")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Division1").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        For Each oSl In SlicerCaches("Slicer_Category1").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Category")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Category1").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        For Each oSl In SlicerCaches("Slicer_Material_Group21").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Material_Group2")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Material_Group21").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        For Each oSl In SlicerCaches("Slicer_Construction_Type\Calendar_month1").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Construction_Type\Calendar_month")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Construction_Type\Calendar_month1").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
    ElseIf Sh.Name = "slv" Then
        For Each oSl In SlicerCaches("Slicer_Division").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Division1")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Division").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        For Each oSl In SlicerCaches("Slicer_Category").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Category1")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Category").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        For Each oSl In SlicerCaches("Slicer_Material_Group2").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Material_Group21")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Material_Group2").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
        For Each oSl In SlicerCaches("Slicer_Construction_Type\Calendar_month").SlicerItems
            oSl.Selected = True
        Next
        With SlicerCaches("Slicer_Construction_Type\Calendar_month1")
            For Each oSl In .SlicerItems
                SlicerCaches("Slicer_Construction_Type\Calendar_month").SlicerItems(oSl.Caption).Selected = oSl.Selected
            Next
        End With
    End If

ExitHandler:
    Application.EnableEvents = True
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[hvi]

dear Hans

many thks for your input and efforts to help so late at night
I will try asap and keep you informed
all the best
just a question
can there be empty lines in a code ?
kindest regards
hermine

[HansV]

There can be as many empty lines in a code module as you like, both between macros and within a macro.

The only exception is when you break a long line of code into two (or more) lines; in that case the lines should be adjacent, without blank lines in between. For example, you could change

Code: Select all

                SlicerCaches("Slicer_Construction_Type\Calendar_month1").SlicerItems(oSl.Caption).Selected = oSl.Selected

to

Code: Select all

                SlicerCaches("Slicer_Construction_Type\Calendar_month1") _
                             .SlicerItems(oSl.Caption).Selected = oSl.Selected

but the following would cause an error message:

Code: Select all

                SlicerCaches("Slicer_Construction_Type\Calendar_month1") _

                             .SlicerItems(oSl.Caption).Selected = oSl.Selected

If a line ends with a continuation character _, the next line (the continuation) should be immediately below it.

[hvi]

dear Hans

many thks again
I have copied code in my file under this worksheet
It worked only the first time when I changed in sheet "Menu" the division and it made the link to sheet "slv" and automatically into "values" , afterwards it did not work anymore ... maybe I am making it to complicate by using sheet "slv" , the intention is that if I make a selection in sheet "menu" that it affected the sheet "value" as well
what I do not know is the influence of the "names " "source" and "caption" in "slicer settings ", does these names all has to be identical in the slicers in "menu" and in "slv" ?
dear Hans , I really do appreciate all your help but please do not let your nightsleep for me
kindest regards
hermine

[HansV]

Using the caption means that the items in the slicers must be exactly the same on each of the sheets.

[hvi]

hi Hans

if you mean in sheet "menu" slicer "division" items = a,S,SO,SS yes they are the same in "menu" and in "slv"
or do you mean the names in slecersettings "caption " being in "menu"= divsion" and in "slv" = divison1" these names in slicersettings are set automatically ?
the names "division " and "division1" in your code are these the names indicated in "slicer settings " as "names to use in formulas "?
maybe there is a problem in the names ??
thks
kindest regards
hermine

[HansV]

I meant the items "S", "SO", "SS" etc., so that's probably not the cause of the problem.

The names "Slicer_Division", "Slicer_Division1" etc. are the names of the slicers - these names are assigned automatically by Excel (but you could change them if you like).

[JS411]

I think I've found the problem. Your code correctly selects slicer items in the other slicer caches, but it doesn't always deselect items, because it may not be possible at that point to deselect an item. The only way I found around this is to select ALL slicer items before selecting/deselecting them the same way as on the active sheet.

Hi all, My first post in your nice community!

I realize this is an old thread, but I was helping someone who was using a version this code that was running slowly and I thought it might help to share a function that addresses some of the issues identified in the earlier discussion.

Code: Select all

Private Function Sync_Slicers(slSource As SlicerCache, slDest As SlicerCache) As Boolean
'--syncs the slicer items in slDest to the Selected state of the item in slSource
'--returns True if sucessful, False if not able to sync

    Dim sli As SlicerItem
    Dim bFound As Boolean, bNotOrphan As Boolean
    
    '--ensure will result in at least one item selected in slDest
    '--check if visible item in slSource is found in slDest
    On Error Resume Next
    For Each sli In slSource.VisibleSlicerItems
        bFound = Not (IsError(slDest.SlicerItems(sli.Caption)))
        If bFound Then
            With slDest.SlicerItems(sli.Caption)
                If Not .Selected Then .Selected = True
            End With
            Exit For
        End If
    Next sli
    '--if not, check if any already visible items in slDest don't exist in slSource
    If Not bFound Then
        For Each sli In slDest.VisibleSlicerItems
            bNotOrphan = Not (IsError(slSource.SlicerItems(sli.Caption)))
            If Not bNotOrphan Then
                bFound = True
                Exit For
            End If
        Next sli
    End If
    '--if not alert and exit.
    If Not bFound Then
        MsgBox "Syncing slicers would leave no items selected in SlicerCache: " _
            & slDest.Name, vbExclamation, "Slicer sync aborted"
    Else
        For Each sli In slSource.SlicerItems
            With slDest.SlicerItems(sli.Caption)
                If .Selected <> sli.Selected Then .Selected = sli.Selected
            End With
        Next
    End If
    On Error GoTo 0
    Sync_Slicers = bFound
End Function

The function can be called like this...

Code: Select all

Public Sub Test_Sync_Slicers()
    Call Sync_Slicers( _
        slSource:=ActiveWorkbook.SlicerCaches("Slicer_Division1"), _
        slDest:=ActiveWorkbook.SlicerCaches("Slicer_Division"))
End Sub

Hope this helps.

[HansV]

Welcome to Eileen's Lounge!

Thanks for the code, it may help others.

[Jan Karel Pieterse]

It may also help to check out my page on slicers and VBA:
http://www.jkp-ads.com/Articles/slicers03.asp