Pivot table filter VBA code running slow

[rnimrick]

Can anyone look at this code and improve on it? I am somewhat new to programming. It takes along time for it to complete. I think it slows down where my If statements are.

Thanks
Rick

Sub FilterPivotCustomerAddress()
'
Dim C_Address As String
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim ws As Worksheet

Application.ScreenUpdating = False
On Error Resume Next

C_Address = Sheets("Address Search").Range("CustomerAddress").Value

Set pt = ActiveSheet.PivotTables(1)
Set pf = pt.PivotFields("Sales Order")
Set pf1 = pt.PivotFields("Street")

pt.ClearAllFilters

If C_Address <> " " Then

For Each pi In pf.PivotItems
Dim leftPi As String
leftPi = Left(pi.Value, 1)

If leftPi <> "H" Then
pi.Visible = False
End If
If pi.Visible = False And leftPi = "R" Then
pi.Visible = True
End If
If pi.Visible = False And leftPi = "S" Then
pi.Visible = True
End If
Next pi

pf1.PivotFilters.Add _
Type:=xlCaptionBeginsWith, Value1:=C_Address

Else
MsgBox ("Please enter a Value in Cell D1 ")

End If

pt.ManualUpdate = False

Set pf = Nothing
Set pt = Nothing

For Each ws In ThisWorkbook.Worksheets
ws.Columns.AutoFit
Next ws
Range("D1").Select

End Sub

 

[par60056]

there are a couple problems. You were on the right course.

You turn off screen updating with:
Application.ScreenUpdating = False

I don't see it turning back on. You need:
Application.ScreenUpdating = True

You also have the line to end manual updating of the pivot but you never put the pivot into manual mode. So every time you change visibility of an item it recalculates the pivot table.

Put:
pt.ManualUpdate=True

before you clear filters

 

[rnimrick]

Thank you so much for your help, I did add the 2 pieces of code like you suggested and it did help but it is still running slow. When I timed it, it took roughly 2 minutes to complete. I know that my problem is in the “For – Next” loop. When I “comment” it out the whole thing takes about 30 seconds to run.
Do you know of any of way I can do the loop?

Sub FilterPivotCustomerAddress()
Dim C_Address As String
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim ws As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
C_Address = Sheets("Address Search").Range("CustomerAddress").Value
Set pt = ActiveSheet.PivotTables(1)
Set pf = pt.PivotFields("Sales Order")
Set pf1 = pt.PivotFields("Street")
pt.ManualUpdate = True
pt.ClearAllFilters
If C_Address <> "" Then
For Each pi In pf.PivotItems
Dim leftPi As String
leftPi = Left(pi.Value, 1)
If leftPi <> "H" Then
pi.Visible = False
End If
If pi.Visible = False And leftPi = "R" Then
pi.Visible = True
End If
If pi.Visible = False And leftPi = "S" Then
pi.Visible = True
End If
Next pi
pf1.PivotFilters.Add _
Type:=xlCaptionBeginsWith, Value1:=C_Address
Else
MsgBox ("Please enter a Value in Cell D1 ")
End If
pt.ManualUpdate = False
Application.ScreenUpdating = True
Set pf = Nothing
Set pt = Nothing
For Each ws In ThisWorkbook.Worksheets
ws.Columns.AutoFit
Next ws
Range("D1").Select
End Sub

 

[par60056]

ok I didn't look too closely because I hoped just setting the manual update would help enough.

Any time you change visibility it has to recalculate the pivot table. There is a potential to turn it off and on for each item.

Instead of:

For Each pi In pf.PivotItems
  Dim leftPi As String
  leftPi = Left(pi.Value, 1)
  If leftPi <> "H" Then 
    pi.Visible = False
  End If
  If pi.Visible = False And leftPi = "R" Then
    pi.Visible = True
  End If
  If pi.Visible = False And leftPi = "S" Then
    pi.Visible = True
  End If
Next pi

Try this:

Dim leftPi As String
For Each Pi In pf.PivotItems
    If InStr(1, "HRS", Left(Pi.Name, 1), vbTextCompare) = 0 Then
        Pi.Visible = False
    End If
Next Pi

 

[rnimrick]

Thank you, it worked, takes about 39 seconds.