Updating a Pivot Table with VBA

[James Wiseman]

Hi all,

I've written a vba code that works, but it takes some time and I'm looking for tips to improve the efficiency. There are two separate loops that share a lot of similarities but whenever I try to combine them I either get an error, or the code fails to update the table.

Any help would be greatly appreciated, James.
VBA code is:

Sub Benefit_Update()
Dim wsBP As Worksheet
Dim wsCC As Worksheet
Dim wsOS As Worksheet
Dim pt As PivotTable
Dim ws As Worksheet
Dim rngItems As Range
Dim c As Range
Dim i As Integer
Dim pf As PivotField
Dim pi As PivotItem
Set pt = Sheets("Benefit Pivot").PivotTables(1)
Set wsBP = Sheets("Benefit Pivot")
Set wsCC = Sheets("Country-Card")
Set wsOS = Sheets("Offsets")
Set SelectCountry = wsOS.Range("rTerritory")
Set SelectCard = wsOS.Range("rCards")

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
For Each ws In Sheets(Array(wsBP.Name))

For Each pt In ws.PivotTables
Set pf = pt.PivotFields("Country")
On Error Resume Next
With pf
.CurrentPage = "(All)"
.AutoSort xlManual, .SourceName
'show all pivot items
For Each pi In pf.PivotItems
pi.Visible = True
Next pi
For Each c In SelectCountry
If UCase(c.Offset(0, 1)) = "X" Then
.PivotItems(c.Value).Visible = False
End If
Next c
.AutoSort xlAscending, .SourceName
End With
Next pt

For Each pt In ws.PivotTables
Set pf = pt.PivotFields("Card")
On Error Resume Next
With pf
.CurrentPage = "(All)"
.AutoSort xlManual, .SourceName
'show all pivot items
For Each pi In pf.PivotItems
pi.Visible = True
Next pi
For Each c In SelectCard
If UCase(c.Offset(0, 1)) = "X" Then
.PivotItems(c.Value).Visible = False
End If
Next c
.AutoSort xlAscending, .SourceName
End With
Next pt
Next ws

Sheets("Benefit Details").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub