Search code examples
excelvbapivot-tableshow-hideslicers

Automate Slicer to Hide and Show Rows in another sheet


I have a pivot table with a slicer and I want to link it to hide or show certain rows based on the slicer selection. The code I have works now for doing that but when there is no slicer selection, I want all those hidden rows to be visible again and that's the part I'm stuck on. Currently when nothing is selected in the slicer, all the rows are hidden, which is the opposite of what I want. Please help!

Option Explicit


Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)

 Dim cell as Range

If Target.Name <> "PivotTable1" Then
Exit Sub
Else

    For Each cell In Sheet2.Range("A2:A25")
        If ActiveWorkbook.SlicerCaches("Slicer_Item").SlicerItems("Pen").Selected = True And cell.Value = "East" Then
            cell.EntireRow.Hidden = True
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Item").SlicerItems("Pencil").Selected = True And cell.Value = "Central" Then
            cell.EntireRow.Hidden = True
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Item").SlicerItems("Pen").Selected = True And cell.Value = "Central" Then
            cell.EntireRow.Hidden = False
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Item").SlicerItems("Pencil").Selected = True And cell.Value = "East" Then
            cell.EntireRow.Hidden = False
        ElseIf ActiveWorkbook.SlicerCaches("Slicer_Item").SlicerItems("Pen").Selected = False And ActiveWorkbook.SlicerCaches("Slicer_Item").SlicerItems("Pencil").Selected = False And cell.Value = "East" Then
            cell.EntireRow.Hidden = False
        End If

    Next
End If

End Sub


Solution

  • Try,

    Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
        Dim SLC As SlicerCache
        Dim Wb As Workbook
        Dim rngDB As Range, rng As Range
        Dim rngU(1 To 2) As Range
        
        If Target.Name <> "PivotTable1" Then Exit Sub
    
        Set Wb = ThisWorkbook
        Set SLC = Wb.SlicerCaches("Slicer_Item")
    
        Set rngDB = Sheet2.Range("a2:a25")
        For Each rng In rngDB
            If rng = "Central" Then
                If rngU(1) Is Nothing Then
                    Set rngU(1) = rng
                Else
                    Set rngU(1) = Union(rngU(1), rng)
                End If
            ElseIf rng = "East" Then
                 If rngU(2) Is Nothing Then
                    Set rngU(2) = rng
                Else
                    Set rngU(2) = Union(rngU(2), rng)
                End If
            End If
        Next
        If SLC.SlicerItems("Pen").Selected = True And SLC.SlicerItems("Pencil").Selected = True Then
            rngU(1).EntireRow.Hidden = False
            rngU(2).EntireRow.Hidden = False
        ElseIf SLC.SlicerItems("Pen").Selected = True Then
            rngU(1).EntireRow.Hidden = True
            rngU(2).EntireRow.Hidden = False
        ElseIf SLC.SlicerItems("Pencil").Selected = True Then
            rngU(1).EntireRow.Hidden = False
            rngU(2).EntireRow.Hidden = True
        End If
    
    End Sub