Question : Update Pivot Table Based On Cell Reference - Error Handling

I use the code below to update additional pivot tables based on a single pivot field in another pivot. Sometimes I get an error "Unable to set value.." out of the blue, and then the code fails to respond period. The only way I get it to work again is if I keep running a clear pivot cache macro and a reset application events macro. Is there additional error code handling that I can insert in the first code to make this seamless when I send it out to end users? I have attached the additional macros I use below.

Code Snippet:

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:

           
           
             Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
 
Application.EnableEvents = False
 
Worksheets("Sheet1").PivotTables("PivotTable1").PivotFields("MyField1").CurrentPage = Range("B5").Value
 
Application.EnableEvents = True
 
End Sub
 
*****************************************************
Public Sub ResetApplicationEvents()
Application.EnableEvents = True
End Sub
 
*****************************************************
Sub DeleteMissingItems2002All()
'prevents unused items in non-OLAP PivotTables
 
Dim pt As PivotTable
Dim ws As Worksheet
Dim pc As PivotCache
 
'change the settings
For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
  Next pt
Next ws
 
'refresh all the pivot caches
For Each pc In ActiveWorkbook.PivotCaches
  On Error Resume Next
  pc.Refresh
Next pc
 
End Sub

           
         

Open in New Window

Select All

Answer : Update Pivot Table Based On Cell Reference - Error Handling

You can use this and this will take care of your problem...

Saurabh...

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:

           
           
             Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
 
Application.EnableEvents = False
On Error Resume Next
abc:
Worksheets("Sheet1").PivotTables("PivotTable1").PivotFields("MyField1").CurrentPage = Range("B5").Value
If Err.Number = 1004 Then
DeleteMissingItems2002All
Err.Clear
GoTo abc:
End If
 
Application.EnableEvents = True
 
End Sub
 
*****************************************************
Public Sub ResetApplicationEvents()
Application.EnableEvents = True
End Sub
 
*****************************************************
Sub DeleteMissingItems2002All()
'prevents unused items in non-OLAP PivotTables
 
Dim pt As PivotTable
Dim ws As Worksheet
Dim pc As PivotCache
 
'change the settings
For Each ws In ActiveWorkbook.Worksheets
  For Each pt In ws.PivotTables
    pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
  Next pt
Next ws
 
'refresh all the pivot caches
For Each pc In ActiveWorkbook.PivotCaches
  On Error Resume Next
  pc.Refresh
Next pc
 
End Sub

           
         

Open in New Window

Select All