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!

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;

1. Department (Row Field)

2. Employee (Row Field & Data Field)

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

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```

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.