Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Hide Pivot Table Fields Pivot Items by Criteria

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only ~~$145.00~~. $59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

Download Example

The code below uses an InputBox to collect the users criteria so they can quickly and easily hide PivotTable 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

Pivot Table Products

O2OLAP for Excel

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft