• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Select Slicers based on the Cell Values excel 2013

P

Pavan.Sada.PS

Member
Hello Fellas,

I am trying to select slicer based on the cell values. help me providing code in order to accomplish this..
 

Attachments

  • Slicer.xlsb
    135.5 KB · Views: 40
I'm bit confused here. You have same code for multiple months. Is this intended?

Ex: Jan, Jun, Jul all have J as month code.
 
Ah I see that you have it from Data Model. This is going to be a bit of pain to work with, especially using array.

Since single SlicerItem.Name is going to be like...
[Month].[Month Code].&[X]

For some reason I'm having trouble getting Data Model to accept constructed string. Stay tuned. I'll update if I find solution.
 
Got it. Not sure the purpose, but code will do what you asked.

Code: 
Sub Test()
Dim dict As Object
Dim lRow As Integer, i As Integer
Dim cel As Range
Dim qString As String

Set dict = CreateObject("Scripting.Dictionary")

lRow = Cells(Rows.Count, 11).End(xlUp).Row
i = 0
For Each cel In Range("K20:K" & lRow)
    i = i + 1
    dict.Add i, "[Month].[Month Code].&[" & cel.Value & "]"
Next cel

ActiveWorkbook.SlicerCaches("Slicer_Month_Code").VisibleSlicerItemsList = Array(dict.items)
End Sub
 
Hi Chihiro,

Sorry couldn't reply on time.. This was really helpful.. Was scratching my head for many days on this.. However if I have pivot table in another sheet and cell references are in another sheet I am getting an error..
 
In that case you need to have additional reference.

Lets say that you have Cell references in Sheet2 (In column A). And pivot is in Sheet1.

The code is ran while having Sheet1 active. Then the code would change to.

Code: 
Sub Test()
Dim dict As Object
Dim lRow As Integer, i As Integer
Dim cel As Range
Dim qString As String

Set dict = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet2") 'Change Sheet reference as needed
lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Change Column# as needed
i = 0
For Each cel In .Range("A2:A" & lRow) 'Change Column & Starting cell reference as needed
    i = i + 1
    dict.Add i, "[Month].[Month Code].&[" & cel.Value & "]"
Next cel
End With
ActiveWorkbook.SlicerCaches("Slicer_Month_Code").VisibleSlicerItemsList = Array(dict.items)
End Sub
 
Hi Chihiro

The Macro is fantastic, i have implemented this macro to my excel files, but i getting problem when i insert in the cell the number which is not present in the slicer table - i get this message Run-time error '1004" The item could not be found in the OLAP Cube.

do you have any idea how to solve it

thanks in advance

BR/Adam
 
You'd need to perform check before you set ".VisibleSlicerItemsList" property, if each item in dictionary items exist in slicer table.

If it doesn't exist you need to remove it from dictionary, before it's used.

Or check before item is added to the dictionary (probably more efficient).

Upload sample workbook where you encounter this error and I can take a look.
 
Hi Chihiro

in the sheet2 i put in the cell ww which is not present in the slicer, and i get this message Run-time error '1004" The item could not be found in the OLAP Cube.

do you have idea how to keep value "ww" and let the macro works?

Thanks in advance
 

Attachments

  • Slicer_example.xlsb
    143.7 KB · Views: 31
Here, try this code.
Code: 
Sub Test2()
Dim dict As Object
Dim lRow As Integer
Dim cel As Range
Dim iString As String, aString As String
Dim sLevel As SlicerCacheLevel, sItem As SlicerItem

Set sLevel = ActiveWorkbook.SlicerCaches("Slicer_Month_Code").SlicerCacheLevels("[Month].[Month Code].[Month Code]")
Set dict = CreateObject("Scripting.Dictionary")

For Each sItem In sLevel.SlicerItems
    dict.Add sItem.Name, 1
Next

With Worksheets("Sheet2") 'Change Sheet reference as needed
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Change Column# as needed
    For Each cel In .Range("A2:A" & lRow) 'Change Column & Starting cell reference as needed
        iString = "[Month].[Month Code].&[" & cel.Value & "]"
        If dict.Exists(iString) Then aString = IIf(aString = "", iString, aString & "," & iString)
    Next cel
End With
ActiveWorkbook.SlicerCaches("Slicer_Month_Code").VisibleSlicerItemsList = Array(Split(aString, ","))

Set dict = Nothing

End Sub
 
Try this.

Code: 
Sub Test()
    Dim slItem As SlicerItem
    For Each slItem In ActiveWorkbook _
        .SlicerCaches("Slicer_Network_Status").SlicerItems
            MsgBox "SlicerItem Name: " & slItem.Name _
                & vbCr & "Selected= " & slItem.Selected
    Next
End Sub
 
Monty,

thanks, but i get only the MsgBox and i need to confirm for each value, how can it solve the problem when the records in the slicer are ~115 000?

Thanks in advance

BR/Adam
 
First of all 100k+ items in slicer is way too much.
Without putting these items into array/dictionary you can't validate that your value exists in there. But it looks like your computer isn't able to handle that much items in memory.

Alternate is going to be less efficient. But you can iterate through each slicer item and see if it matches your list. If yes, put the value into array.

However, this method will require multiple loops through slicer items list and will be slow.

Instead of using code. I'd recommend building multiple slicer to shrink down your end slicer.

Method using multiple slicer:
In your data model, add columns that acts as sub category for your slicer.
You may need more than one. Since you have 100k+ items in your slicer. I'd recommend no more than 50 in a given slicer, though it will work with 1,000.

Then set all but the top level slicer to show only items available.

As you select item from top slicer on ward, each selection will shrink list of available items to select.
 
Hello

Thanks for this!
I've been searching around on how to mirror slicer selections for a while.
Basically I have one slicer where i select client x and then I have another slicer which should select all except that client x.
The purpose is to compare client x performance against peers.

Now to the question: your macro works and selects all slicer elements but would it be possible to select all EXCEPT one which is specified in a cell?
I'm not so fluent in vba to edit the loop myself.
Any help is greatly appreciated.



Chihiro said:
In that case you need to have additional reference.

Lets say that you have Cell references in Sheet2 (In column A). And pivot is in Sheet1.

The code is ran while having Sheet1 active. Then the code would change to.

Code: 
Sub Test()
Dim dict As Object
Dim lRow As Integer, i As Integer
Dim cel As Range
Dim qString As String

Set dict = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet2") 'Change Sheet reference as needed
lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Change Column# as needed
i = 0
For Each cel In .Range("A2:A" & lRow) 'Change Column & Starting cell reference as needed
    i = i + 1
    dict.Add i, "[Month].[Month Code].&[" & cel.Value & "]"
Next cel
End With
ActiveWorkbook.SlicerCaches("Slicer_Month_Code").VisibleSlicerItemsList = Array(dict.items)
End Sub
Click to expand...
 
Hi
In the end I managed to edit your code as follows.
basically it selects everything in the slicer except one element which comes from cell D2

Thanks again for your input!

Code: 
Sub except()

Dim dict As Object
Dim lRow As Integer, i As Integer
Dim cel As Range
Dim qString As String
Set dict = CreateObject("Scripting.Dictionary")
Application.CalculateUntilAsyncQueriesDone
With Worksheets("Selections") 'Change Sheet reference as needed
lRow = .Cells(Rows.Count, 35).End(xlUp).Row 'Change Column# as needed
i = 0
For Each cel In .Range("AI2:AI" & lRow) 'Change Column & Starting cell reference as needed
   i = i + 1
  If (cel <> "(blank)" And cel <> Sheet23.Range("D2")) Then
    dict.Add i, "[Category].[MasterBrand].&[" & cel.Value & "]"
End If
Next cel
End With
ActiveWorkbook.SlicerCaches("Slicer_MasterBrand1").VisibleSlicerItemsList = Array(dict.items)
End Sub
 
You must log in or register to reply here.
Back
Top