VBA Max Workweek

[rbirch]

My question is why does my code crap out on finding the max and leaves 18, 19 and 20 selected in the attached PNG for Workweek"? Does Excel have max or min of Pivot Items it can select?

I tried using the macro I have on a fresh copy of Excel to get rid of any behind the scene errors.

This is the code I use albeit very shorten.

Thanks for your help.

Sub Search_Pivot_Setup()
'1
' Search_Pivot_Setup Macro

Application.DisplayAlerts = False

'add worksheets
Dim wk1 As Worksheet
Set wk1 = ThisWorkbook.Worksheets("Records")
Dim piItem As PivotItem
Dim lngMaxValue As Double
Set piItem = Nothing


ThisWorkbook.ActiveSheet.PivotTables("PivotTable1").ClearTable

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'Turned off calculations and screen updating

With wk1.PivotTables("PivotTable1")
    .InGridDropZones = True
    .RowAxisLayout xlTabularRow
End With
With wk1.PivotTables("PivotTable1").PivotFields("Workweek")
.Orientation = xlPageField
.Position = 1
.PivotItems("2").Visible = False
.EnableMultiplePageItems = True
End With
'added code
For Each piItem In wk1.PivotTables("PivotTable1").PivotFields("Workweek").PivotItems
On Error Resume Next
  If piItem.Value > lngMaxValue Then lngMaxValue = piItem.Value
With wk1.PivotTables("PivotTable1").PivotFields("Workweek") 'added with statement in the loop
    .Orientation = xlPageField
    .Position = 1
    .PivotItems(lngMaxValue).Visible = False
    .EnableMultiplePageItems = True
End With
Next piItem

With wk1.PivotTables("PivotTable1").PivotFields("Workweek") 'added with
    .Orientation = xlPageField
    .Position = 1
    .PivotItems(lngMaxValue).Visible = True
    .EnableMultiplePageItems = True
End With
With wk1.PivotTables("PivotTable1").PivotFields("Workweek")
.Orientation = xlPageField
.Position = 1
.EnableMultiplePageItems = True
End With
End Sub