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

Slicers Controlled by a Cell Value

Christof

Member
Hi guys, I'm sorry being thick..
But does anyone have a sample VBA code that I can append to mine.
Basically I want to be able to change a cell value ($E$7) and it will automatically have that as the slicer selection.
My slicer is called "Slicer_Haul".

Basically, cell $e$7 is a dropdown menu and I'd like that to drive the slicer.
I have attached a basic sample file.

Thanks
 

Attachments

  • Slicer Eg.xlsx
    18.4 KB · Views: 49
Something like...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sc As SlicerCache
Dim si As SlicerItem
Set sc = ThisWorkbook.SlicerCaches("Slicer_Haul")
If Not Intersect(Target, [E7]) Is Nothing Then
    If Target.Value = "(ALL)" Then
        sc.ClearAllFilters
    Else
    For Each si In sc.SlicerItems
        If Target.Value = si.Name Then
            si.Selected = True
        Else
            si.Selected = False
        End If
    Next
    End If
End If
End Sub
 

Attachments

  • Slicer Eg.xlsb
    22.6 KB · Views: 153
So just a quick additional question.. could you recommend how to insert it into my existing code?

As you can see, my code will change the layout of 3 different pivot tables if values in cells C3 to M3 are changed. So obviously using the slicers i shouldnt have to go through that process.

Many thanks
Chris



Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim KeyCells As Range
    Set KeyCells = Range("C3:M3")
       
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        On Error GoTo clean_up
        Application.Calculation = xlManual
        Application.StatusBar = "Hi " & Application.UserName & "! Your report will be ready in a few seconds..."
        Application.EnableEvents = False
        'Set the Variables to be used
        Dim pt1 As PivotTable
        Dim pt2 As PivotTable
        Dim pt3 As PivotTable
       
       
        Dim Field1 As PivotField
        Dim Field2 As PivotField
        Dim Field3 As PivotField
        Dim Field4 As PivotField
        Dim Field5 As PivotField
        Dim Field6 As PivotField
       
        Dim NewCat2 As String, NewCat3 As String
        Dim pi As PivotItem
        Dim Yeartype As String, sumField As String
        Yeartype = Range("h3").Value
       
       
         NewCat2 = Range("g3").Value
         NewCat3 = Range("g3").Value - 1
         NewCat4 = "Yes"
       
        '-----Pivot1-----
   
        Set pt1 = PivotTables("PivotTable1")
        pt1.ManualUpdate = True
        sumField = Range("C3").Value
        With pt1.PivotFields(Yeartype)
            .Orientation = xlRowField
            .Position = 1
        End With
        If Yeartype = "Financial Year" Then
            pt1.PivotFields("Calendar Year").Orientation = xlHidden
            Set Field2 = pt1.PivotFields("Financial Year2")
        Else
            pt1.PivotFields("Financial Year").Orientation = xlHidden
            Set Field2 = pt1.PivotFields("Calendar Year2")
        End If
        pt1.DataFields(1).Orientation = xlHidden
        pt1.PivotFields(sumField).Orientation = xlDataField
       
        pt1.AllowMultipleFilters = True
       
        pt1.ClearAllFilters
       
       
        For Each pi In Field2.PivotItems
            If Not ((pi.Name = NewCat2) Or (pi.Name = NewCat3)) Then
                pi.Visible = False
            End If
        Next
        pt1.ManualUpdate = False
        pt1.RefreshTable
        '-----Pivot2-----
        Set pt2 = PivotTables("PivotTable2")
        Set Field5 = pt2.PivotFields("Today & LY")
        pt2.ManualUpdate = True
        sumField = Range("C3").Value
        With pt2.PivotFields(Yeartype)
            .Orientation = xlRowField
            .Position = 1
        End With
        If Yeartype = "Financial Year" Then
            pt2.PivotFields("Calendar Year").Orientation = xlHidden
            Set Field4 = pt2.PivotFields("Financial Year2")
        Else
            pt2.PivotFields("Financial Year").Orientation = xlHidden
            Set Field4 = pt2.PivotFields("Calendar Year2")
        End If
       
        pt2.AllowMultipleFilters = True
        pt2.ClearAllFilters
       
               
        Field5.CurrentPage = NewCat4
       
        For Each pi In Field4.PivotItems
            If Not ((pi.Name = NewCat2) Or (pi.Name = NewCat3)) Then
                pi.Visible = False
            End If
        Next
        pt2.ManualUpdate = False
        pt2.RefreshTable
       
       
   
        '-----Pivot3-----
   
   
        Set pt3 = PivotTables("PivotTable3")
        pt3.ManualUpdate = True
        sumField = Range("C3").Value
        With pt3.PivotFields(Yeartype)
            .Orientation = xlRowField
            .Position = 1
        End With
        If Yeartype = "Financial Year" Then
            pt3.PivotFields("Calendar Year").Orientation = xlHidden
            Set Field6 = pt3.PivotFields("Financial Year2")
        Else
            pt3.PivotFields("Financial Year").Orientation = xlHidden
            Set Field6 = pt3.PivotFields("Calendar Year2")
        End If
        pt3.DataFields(1).Orientation = xlHidden
        pt3.PivotFields(sumField).Orientation = xlDataField
       
        pt3.AllowMultipleFilters = True
        pt3.ClearAllFilters
       
        Field6.ClearAllFilters
       
       
        For Each pi In Field6.PivotItems
            If Not ((pi.Name = NewCat2) Or (pi.Name = NewCat3)) Then
                pi.Visible = False
            End If
        Next
        pt3.ManualUpdate = False
        pt3.RefreshTable
   End If
   
        Application.Calculation = xlAutomatic
        Application.StatusBar = "All done!"
clean_up:
       Application.EnableEvents = True
End Sub
 
I'd recommend uploading sample file that demonstrates what your code does. You'll get a quicker and more accurate response if you do ;)

Desensitize the data first though.
 
I'd highly recommend using PowerQuery (and PowerPivot if you have access to it).

But following should work.
Code:
'Rest of your code
        pt3.ManualUpdate = False
        pt3.RefreshTable


  End If
  Dim sc As SlicerCache, si As SlicerItem
  Set sc = ThisWorkbook.SlicerCaches("Slicer_Haul")
  If Not Intersect(Target, [E7]) Is Nothing Then
        If Target.Value = "(All)" Then
            sc.ClearAllFilters
        Else
            For Each si In sc.SlicerItems
                If Target.Value = si.Name Then
                    si.Selected = True
                Else
                    si.Selected = False
                End If
            Next
        End If
    End If
       

        Application.Calculation = xlAutomatic
        Application.StatusBar = "All done!"
'Rest of Your code
 
There are quite a few.

1. It uses data model, using VertiPaq engine as architecture. This allows very efficient data compression as well as use of powerful DAX language in analyzing data.

2. By using PowerQuery as ETL tool before loading to data model. It ensures data is denormalized and optimized for reporting, rather than data entry. It's also meant for importing data from various sources and consolidating them in single model.

3. By using relationships, fact table can be connected to multiple dimension tables. For quick and efficient slicing and dicing of data.

And pivot table constructed from data model will allow use of objects/properties not available in standard pivot table through VBA.

Such as .VisibleItemsList/.VisibleSlicerItemsList.
Which will allow you to control and read visible item via array. Rather than iterating over each item. Which is significantly faster.
 
Thanks for the advice and thanks for the assistance with my VBA :)

Is the transition from the kind of stuff I have done here to PoverPivot a big jump?
 
If you have no experience with SQL, SQL Analysis Server etc. It will be a big jump. While it is packaged with Excel, you will have issue understanding DAX and M, if you use traditional Excel logic (cell referencing).

It is developed by SQL team at MS, and uses database and data cube concepts, heavily relying on row/filter context to return result.

Try going through resources listed in link.
https://www.contextures.com/excelpowerpivotresources.html
 
Thanks for the advice.
To be honest I am trying to get away from my accounting role and more into the data stuff.
You'll see from a lot of my formulas that even the VBA stuff is new to me only about a month ago, and I'm probably still stuck in my ways a bit around traditional excel formulae (sumifs, vlookups, etc).

My goal is to get stuck into stuff like this, SAS, SQL, etc, so if you feel PowerPivot would be another useful resource then I'll get that added to my study list.

Thanks once again for the advice my friend :)
 
Something like...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sc As SlicerCache
Dim si As SlicerItem
Set sc = ThisWorkbook.SlicerCaches("Slicer_Haul")
If Not Intersect(Target, [E7]) Is Nothing Then
    If Target.Value = "(ALL)" Then
        sc.ClearAllFilters
    Else
    For Each si In sc.SlicerItems
        If Target.Value = si.Name Then
            si.Selected = True
        Else
            si.Selected = False
        End If
    Next
    End If
End If
End Sub

Thank you, Chihiro, for this code! You made my problem solving easy.

I duplicated your sub and stacked them on top of each other:

>>> use code - tags <<<
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sc As SlicerCache
Dim si As SlicerItem
Set sc = ThisWorkbook.SlicerCaches("Slicer_Region")
If Not Intersect(Target, [B5]) Is Nothing Then
    If Target.Value = "" Then
        sc.ClearAllFilters
    Else
    For Each si In sc.SlicerItems
        If Target.Value = si.Name Then
            si.Selected = True
        Else
            si.Selected = False
        End If
    Next
    End If
End If
Dim zc As SlicerCache
Dim zi As SlicerItem
Set zc = ThisWorkbook.SlicerCaches("Slicer_Region1")
If Not Intersect(Target, [B5]) Is Nothing Then
    If Target.Value = "" Then
        zc.ClearAllFilters
    Else
    For Each zi In zc.SlicerItems
        If Target.Value = zi.Name Then
            zi.Selected = True
        Else
            zi.Selected = False
        End If
    Next
    End If
End If
End Sub

This allowed me to connect two standard tables to a single cell that filters both tables. Context - standard tables (as opposed to pivot tables) can't be united with one slicer. So for each individual table, one must have a unique slicer. The code above allows one to link as many slicers / regular tables together to be filtered by a single cell.
 
Back
Top