Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 29

Thread: How to use VBA Slicer to connect two PivotTable

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    VBAX Newbie
    Joined
    Mar 2016
    Posts
    2
    Location

    How to use VBA Slicer to connect two PivotTable

    Currently, I create VBA coding to insert pivot table. However, I find that the table created by coding cannot use slicer to connect two different pivot table. Can anyone help? Thanks!

    Untitled.jpg
    Attached Files Attached Files

  2. #2
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    The slicer needs to share the same pivot cache; you've created 2 pivot caches as well as 2 pivot tables, so something along the lines of:
    Sub Insert_Pivot_tables()
    Set PC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R9C3") 'create one pivotcache.
    Set PT1 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C1") 'create pivot table 1 (name isn't important) using cache just created.
    Set PT2 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C5") 'create pivot table 2 (name isn't important) using the same cache.
    
    'then you can programmatically add the slicer and link the two pivot tables with it:
    Set SC = ActiveWorkbook.SlicerCaches.Add(PT1, "SN") 'create one slicer cache linked to the first pivot table.
    SC.Slicers.Add ActiveSheet, , "SN", "SN", 210.75, 549.75, 144, 198.75 'add slicer to that slicer cache.
    SC.PivotTables.AddPivotTable (PT2) 'add 2nd pivot table to slicer cache.
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  3. #3
    VBAX Newbie
    Joined
    Mar 2016
    Posts
    2
    Location
    It works! Thank you very much for your teaching!

  4. #4
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location

    Slicer Report Connections

    Quote Originally Posted by wendyto View Post
    It works! Thank you very much for your teaching!
    Hi, the above code works for only 2 pivot tables.

    I need code for connecting multiple pivot tables which are named say 10A,10B,10C etc., to a single slicer (Type).

    my recorded macro is showing error, below is the recorded code

    ActiveWorkbook.SlicerCaches("Slicer_Type").PivotTables. _
            AddPivotTable (ActiveSheet.PivotTables("10A"))
        ActiveWorkbook.SlicerCaches("Slicer_Type").PivotTables. _
            AddPivotTable (ActiveSheet.PivotTables("10B"))
        ActiveWorkbook.SlicerCaches("Slicer_Type").PivotTables. _
            AddPivotTable (ActiveSheet.PivotTables("10C"))
        ActiveWorkbook.SlicerCaches("Slicer_Type").PivotTables. _
            AddPivotTable (ActiveSheet.PivotTables("10D"))

  5. #5
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by predzer View Post
    Hi, the above code works for only 2 pivot tables.
    It works for 3 here:
    Sub Insert_Pivot_tables()
    Set PC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R9C3") 'create one pivotcache.
    Set PT1 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C1") 'create pivot table 1 (name isn't important) using cache just created.
    Set PT2 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C5") 'create pivot table 2 (name isn't important) using the same cache.
    Set PT3 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C10") 'create pivot table 3 (name isn't important) using the same cache.
    
    'then you can programmatically add the slicer and link the two pivot tables with it:
    Set SC = ActiveWorkbook.SlicerCaches.Add(PT1, "SN") 'create one slicer cache linked to the first pivot table.
    SC.Slicers.Add ActiveSheet, , "SN", "SN", 210.75, 549.75, 144, 198.75 'add slicer to that slicer cache.
    SC.PivotTables.AddPivotTable (PT2) 'add 2nd pivot table to slicer cache.
    SC.PivotTables.AddPivotTable (PT3) 'add 3rd pivot table to slicer cache.
    End Sub
    Even your code works if the pivot tables concerned all use the same PivotCache.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #6
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    It works for 3 here:
    Sub Insert_Pivot_tables()
    Set PC = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R9C3") 'create one pivotcache.
    Set PT1 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C1") 'create pivot table 1 (name isn't important) using cache just created.
    Set PT2 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C5") 'create pivot table 2 (name isn't important) using the same cache.
    Set PT3 = PC.CreatePivotTable(TableDestination:="Sheet1!R15C10") 'create pivot table 3 (name isn't important) using the same cache.
    
    'then you can programmatically add the slicer and link the two pivot tables with it:
    Set SC = ActiveWorkbook.SlicerCaches.Add(PT1, "SN") 'create one slicer cache linked to the first pivot table.
    SC.Slicers.Add ActiveSheet, , "SN", "SN", 210.75, 549.75, 144, 198.75 'add slicer to that slicer cache.
    SC.PivotTables.AddPivotTable (PT2) 'add 2nd pivot table to slicer cache.
    SC.PivotTables.AddPivotTable (PT3) 'add 3rd pivot table to slicer cache.
    End Sub
    Even your code works if the pivot tables concerned all use the same PivotCache.

    Thanks for your time p45cal.

    But I have already created multiple pivot tables with same cache and named them all say 10A,10B,10C and so on.. i only need the code for slicer report connections to sync them all up.. with the above code when i use pivot table name in the slicer like instead of

    SC.PivotTables.AddPivotTable (PT3)
    this

    SC.PivotTables.AddPivotTable (10A)
    then the code wont run. so im looking code for only connecting existing pivot tables to a new slicer.

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    It would probably need to be something like:
    SC.PivotTables.AddPivotTable (ActiveSheet.PivotTables("10A"))

    If that still fails (what's the error mesage?) then try running this little snippet:
    Sub test()
    For Each pt In ActiveSheet.PivotTables
      pt.TableRange2.Select
      MsgBox "Cache Index: " & pt.CacheIndex & vbLf & "Pivot table name: " & pt.Name
    Next pt
    End Sub
    It will run through the pivot tables on the active sheet, selecting them one at a time and display their name and cache index in a pop-up message box.
    Make sure that the cache index is the same for every pivot table you want to be controlled by the same slicer.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    It would probably need to be something like:
    SC.PivotTables.AddPivotTable (ActiveSheet.PivotTables("10A"))

    If that still fails (what's the error mesage?) then try running this little snippet:
    Sub test()
    For Each pt In ActiveSheet.PivotTables
      pt.TableRange2.Select
      MsgBox "Cache Index: " & pt.CacheIndex & vbLf & "Pivot table name: " & pt.Name
    Next pt
    End Sub
    It will run through the pivot tables on the active sheet, selecting them one at a time and display their name and cache index in a pop-up message box.
    Make sure that the cache index is the same for every pivot table you want to be controlled by the same slicer.

    This worked perfectly for the pivot tables in the same sheet. All the Pivot Tables had same index.

    But i also have pivot tables in multiple sheets with same cache index, but the code is not working for the pivot tables in other sheets.

    Can you please help me out for connecting pivots in different sheets to a single slicer? I've got codes for syncing filters of all pivots but couldnt find a code for slicer report connections from multiple sheets.

    Thanks again for your time

  9. #9
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    This one goes through each slicer cache in the workbook, looks at its first pivot table's cache index, then goes through all the other pivot tables in the workbook and if they're based on the same pivot cache, connects the slicer cache to that pivot table:
    Sub blah1()
    For Each sc In ThisWorkbook.SlicerCaches
      If sc.PivotTables.Count > 0 Then
        ThisSCIndex = sc.PivotTables(1).CacheIndex
        For Each sht In ThisWorkbook.Sheets
          For Each pt In sht.PivotTables
            If pt.CacheIndex = ThisSCIndex Then sc.PivotTables.AddPivotTable (pt)
          Next pt
        Next sht
      End If
    Next sc
    End Sub




    This one looks at all the slicers currently associated with the pivot table that the selected cell is in, then goes through all the pivot tables in the workbook and if they're the same pivot cache connects the slicer cache to that pivot table.
    Sub blah2()
    'select a cell on a pivot table first!
    Set pt = Selection.PivotTable
    For Each slcr In pt.Slicers
      For Each sht In ThisWorkbook.Sheets
        For Each pvt In sht.PivotTables
          If pvt.CacheIndex = pt.CacheIndex Then slcr.SlicerCache.PivotTables.AddPivotTable (pvt)
        Next pvt
      Next sht
    Next slcr
    End Sub




    This next one needs you to select a slicer first and connects all pivot tables in the workbook which use the same pivot table cache as the slected slicer's pivot table's cache to it - but just that slicer.
    Sub blah3()
    'select a pivot table's slicer first!
    Set SLCR = ThisWorkbook.ActiveSlicer
    If SLCR Is Nothing Then
      MsgBox "Select a slicer!"
    Else
      Set sc = SLCR.SlicerCache
      Set thisPvt = sc.PivotTables(1)    'will fail if it's not linked to any pivot table.
      For Each sht In ThisWorkbook.Sheets
        For Each pvt In sht.PivotTables
          If pvt.CacheIndex = thisPvt.CacheIndex Then sc.PivotTables.AddPivotTable (pvt)
        Next pvt
      Next sht
    End If
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  10. #10
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    This next one needs you to select a slicer first and connects all pivot tables in the workbook which use the same pivot table cache as the slected slicer's pivot table's cache to it - but just that slicer.
    Sub blah3()
    'select a pivot table's slicer first!
    Set SLCR = ThisWorkbook.ActiveSlicer
    If SLCR Is Nothing Then
      MsgBox "Select a slicer!"
    Else
      Set sc = SLCR.SlicerCache
      Set thisPvt = sc.PivotTables(1)    'will fail if it's not linked to any pivot table.
      For Each sht In ThisWorkbook.Sheets
        For Each pvt In sht.PivotTables
          If pvt.CacheIndex = thisPvt.CacheIndex Then sc.PivotTables.AddPivotTable (pvt)
        Next pvt
      Next sht
    End If
    End Sub
    I tested all the above codes, I did not get any errors, execution was smooth. BUT the pivot tables are still not connected.

    Below is my code, Ive created a Slicer for pivottable "10A" & Pivot field "Type" and tried your 3rd code.

    Sub Add_Slicer()
    
    'Creating New Slicer(Recorded it)
    
        ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables( _
        "10A"), "Type").Slicers.Add ActiveSheet, , "Type", _
        "Type", 139.5, 648, 144, 198.75
        
        ActiveSheet.Shapes.Range(Array("Type")).Select    'Selected the slicer
        
        Set SLCR = ThisWorkbook.ActiveSlicer
        If SLCR Is Nothing Then
        MsgBox "Select a slicer!"
        Else
        Set sc = SLCR.SlicerCache
        Set thisPvt = sc.PivotTables(1)    'will fail if it's not linked to any pivot table.
        For Each sht In ThisWorkbook.Sheets
        For Each pvt In sht.PivotTables
          If pvt.CacheIndex = thisPvt.CacheIndex Then sc.PivotTables.AddPivotTable (pvt)
        Next pvt
      Next sht
    End If
        
    End Sub

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Sub Add_Slicer()
    Set SLCR = ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("10A"), "Type").Slicers.Add(ActiveSheet, , "Type", "Type", 139.5, 648, 144, 198.75)
    Set sc = SLCR.SlicerCache
    Set thisPvt = sc.PivotTables(1)    'will fail if it's not linked to any pivot table.
    For Each sht In ThisWorkbook.Sheets
      For Each pvt In sht.PivotTables
        If pvt.CacheIndex = thisPvt.CacheIndex Then sc.PivotTables.AddPivotTable (pvt)
      Next pvt
    Next sht
    End Sub
    Quote Originally Posted by predzer View Post
    BUT the pivot tables are still not connected.
    How are you determining this?
    Arethe pivot tables all in the workbook that the code is sitting in?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #12
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    How are you determining this?
    Arethe pivot tables all in the workbook that the code is sitting in?
    Yes they are in the same workbook but different sheets. After i run the code and view slicer’s report connections, only the pivot table from which the slicer was created is checked. Rest of the pivot tables are not checked.

    (PS: Pivot tables were generated using “show report filter pages” from a master pivot table. Slicer was created from the same master pivot for which im trying to connect its respective pivot tables generated)

  13. #13
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    In the attached, 2 buttons.
    Works here.
    Attached Files Attached Files
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  14. #14
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    In the attached, 2 buttons.
    Works here.
    Im so so greatfull to you. The above code was not running from that respective workbook so i put in personal book and changed thisworkbook to activeworkbook and it did the magic!!!

  15. #15
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Last but not the least. Can you help me out to create a slicer for each of the filter in pivot table instead creating a code for individual filter.

    Basically i want to replace the below code with a loop for each of the pivotfield.

    Set SLCR = ActiveWorkbook.SlicerCaches.Add2(ActiveSheet.PivotTables("10A"), "Type") _
    .Slicers.Add(ActiveSheet, , "Type", "Type", 139.5, 648, 144, 198.75)

  16. #16
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Show report filter pages… only works for items in the Filter area (PageField areas) and then only for the filtered items there (see below for more on this).
    Sub blah4()
    Set pt = ActiveSheet.PivotTables("10A")
    For Each pf In pt.PageFields
      pt.ShowPages pf
    Next pf
    End Sub
    If you've ticked the check box Select Multiple Items in any of those field's dropdowns new sheets will only be generated for ticked items.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  17. #17
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    Show report filter pages… only works for items in the Filter area (PageField areas) and then only for the filtered items there (see below for more on this).
    Sub blah4()
    Set pt = ActiveSheet.PivotTables("10A")
    For Each pf In pt.PageFields
      pt.ShowPages pf
    Next pf
    End Sub
    If you've ticked the check box Select Multiple Items in any of those field's dropdowns new sheets will only be generated for ticked items.

    This is fine. I think you misunderstood my post.

    I wanted to create a new slicer for each of the PageField areas.

  18. #18
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Yes I did… I'll be back later.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  19. #19
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Do something along these lines:
    Sub Add_Slicers2()
    Set pt = ActiveSheet.PivotTables("10A")
    TheTop = 140
    For Each pf In pt.PivotFields
      Set sc = ActiveWorkbook.SlicerCaches.Add2(pt, pf.Name)
      Set SLCR = sc.Slicers.Add(ActiveSheet, , pf.Name, pf.Name, TheTop, 648, 144, 198.75)
      TheTop = TheTop + 5
      For Each sht In ThisWorkbook.Sheets
        For Each pvt In sht.PivotTables
          If pvt.CacheIndex = pt.CacheIndex Then sc.PivotTables.AddPivotTable (pvt)
        Next pvt
      Next sht
    Next pf
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  20. #20
    VBAX Regular
    Joined
    Jul 2018
    Posts
    23
    Location
    Quote Originally Posted by p45cal View Post
    Do something along these lines:
    Sub Add_Slicers2()
    Set pt = ActiveSheet.PivotTables("10A")
    TheTop = 140
    For Each pf In pt.PivotFields
      Set sc = ActiveWorkbook.SlicerCaches.Add2(pt, pf.Name)
      Set SLCR = sc.Slicers.Add(ActiveSheet, , pf.Name, pf.Name, TheTop, 648, 144, 198.75)
      TheTop = TheTop + 5
      For Each sht In ThisWorkbook.Sheets
        For Each pvt In sht.PivotTables
          If pvt.CacheIndex = pt.CacheIndex Then sc.PivotTables.AddPivotTable (pvt)
        Next pvt
      Next sht
    Next pf
    End Sub
    The above code runs smooth, but it creates a new slicer for every column in the data sheet.

    Say i have 30 columns and selected only 5 filters for a pivot table. The above code is creating 30 slicers. I only need 5 slicers for that pivot fields.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •