Hide Pivot Table Fields Pivot Items by Criteria

Download Example

The code below uses an input box to collect the users criteria so they can quickly and easily hide pivot table field items by a criteria they specify.

The raw data that the Pivot Table is based on is 3 columns consisting of the Fields:

Department (Row Field)
Employee (Row Field & Data Field)
Age (Row Field & Data Field. Also the items that are hidden by criteria)

The Code to Hide PivotTable Fields (Age) Items by Criteria

Sub HideByCriteria()

'Declare variables

'SEE: http://www.ozgrid.com/VBA/variables.htm

'SEE: http://www.ozgrid.com/VBA/variable-scope-lifetime.htm

Dim pt As PivotTable, pi As PivotItem

Dim lAge As Long

Dim strCri As String, strCri1 As String, strCri2 As String

Dim bHide As Boolean

Dim xlCalc As XlCalculation



    Set pt = Sheet4.PivotTables("PivotTable1")

    'SEE: http://www.ozgrid.com/Excel/excel-pivot-tables.htm

   



        strCri = InputBox("Enter your criteria for hiding employees by age." _

            & Chr(13) & "Valid Criteria Examples:" _

            & Chr(13) & "'>20' for ages above 20." _

            & Chr(13) & "'>=30  <40' for ages equal to or above 30 but below 40.", "HIDE AGE")

            'SEE: http://www.ozgrid.com/VBA/inputbox.htm



    'They Cancelled.

     If strCri = vbNullString Then Exit Sub

     

    'Remove any *excess* spacing

     strCri = Trim(strCri)

     

     'Speed up code.

     'SEE: http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm

     'SEE: http://www.ozgrid.com/VBA/calc-stop.htm

     

    'Set PT to manual update.

     pt.ManualUpdate = True

    'SEE: http://www.ozgrid.com/VBA/pivot-table-fields.htm

    

    'Get users calculation mode, go to manual & stop screen updating

     With Application

            xlCalc = .Calculation

            .Calculation = xlCalculationManual

            '.ScreenUpdating = False

     End With

    

    'Error trap for non valid criteria

    On Error GoTo NonValidCriteria:

    'SEE: http://www.ozgrid.com/VBA/ExcelVBAErrors.htm

    

    'Find out if between or single criteria.

    If InStr(1, strCri, " ") = 0 Then 'Single

        For Each pi In pt.PivotFields("Age").PivotItems

        'SEE: http://www.ozgrid.com/VBA/loops.htm

        'SEE: http://www.ozgrid.com/VBA/VBALoops.htm

            lAge = pi

            bHide = Evaluate(lAge & strCri)

            pi.Visible = bHide

        Next pi

    Else 'Between

            'Get 1st criteria

             strCri1 = Mid(strCri, 1, InStr(1, strCri, " ") - 1)

            'Get 2nd criteria

             strCri2 = Mid(strCri, InStr(1, strCri, " ") + 1, 256)

        For Each pi In pt.PivotFields("Age").PivotItems

            lAge = pi

            bHide = Evaluate(lAge & strCri1) And Evaluate(lAge & strCri2)

            pi.Visible = bHide

        Next pi

    End If

    

    pt.ManualUpdate = False

    With Application

            .Calculation = xlCalc

            .ScreenUpdating = True

     End With

    

    

Exit Sub

NonValidCriteria:

MsgBox "Your criteria is not valid", vbCritical

     pt.ManualUpdate = False

     With Application

            .Calculation = xlCalc

            .ScreenUpdating = True

     End With

End Sub

The Code to Show All PivotTable Fields (Age) Items

Sub ShowAll()

Dim pt As PivotTable, pi As PivotItem

Dim xlCalc As XlCalculation



    Set pt = Sheet4.PivotTables("PivotTable1")



    pt.ManualUpdate = True

    

    With Application

            xlCalc = .Calculation

            .Calculation = xlCalculationManual

            .ScreenUpdating = False '

    End With

    

        On Error Resume Next



        For Each pi In pt.PivotFields("Age").PivotItems

                    pi.Visible = True

        Next pi

        

        On Error GoTo 0

  pt.ManualUpdate = False

    With Application

            .Calculation = xlCalc

            .ScreenUpdating = True

    End With

End Sub

Download Example