View Full Version : Progress Bar for refreshing pivot caches

06-25-2009, 02:03 AM

I'm having a little trouble getting my statusbar progress bar to work when refreshing Excel pivot caches (each cache is connected to a large Access database table). My first code attempt is as follows:

Sub RefreshPivots()

Dim pc As PivotCache, lngTotalRecords As Long, lngRecordTally As Long
Dim intBlack As Integer, intEmpty As Integer

' Obtain the total number of records in all pivot caches combined
For Each pc In ThisWorkbook.PivotCaches
lngTotalRecords = lngTotalRecords + pc.RecordCount
Next pc

' Show 20 empty squares in the status bar
Application.StatusBar = WorksheetFunction.Rept(ChrW(9643), 20)

' Refresh pivot caches and update progress bar
For Each pc In ThisWorkbook.PivotCaches
lngRecordTally = lngRecordTally + pc.RecordCount
intBlack = Int(lngRecordTally / lngTotalRecords * 20) ' Number of black squares to display
intEmpty = 20 - intBlack ' Number of empty squares
Application.StatusBar = WorksheetFunction.Rept(ChrW(9642), intBlack) & _
WorksheetFunction.Rept(ChrW(9643), intEmpty)
Next pc

MsgBox "Complete!"
Application.StatusBar = False ' Reset the status bar

End Sub

This procedure works without any errors, but the progress bar stays on 0 for a long time (the first cache has 900,000 records), then jumps up to 90% (18 of the 20 squares) and finishes the remaining 100,000 records (16 caches) very quickly. What I would like is for the progress bar to move up gradually according to the number of records refreshed, rather than the number of caches refreshed. For example, for each 50,000 records refreshed in cache 1, the bar increments by 5% (ie 2 squares), instead of jumping to 18 squares after the whole cache 1 has refreshed.

I thought perhaps I could set the BackgroundQuery property of each pivot table to True - then if could update the progress bar while the cache is refreshing. I tried the following:

Sub RefreshPivots()

Dim pv As PivotTable, pc As PivotCache, sh As Worksheet

For Each sh In ThisWorkbook.Worksheets
For Each pv In sh.PivotTables
Set pc = pv.PivotCache
pc.BackgroundQuery = True

On Error Resume Next

If Err.Number = 1004 Then ' This error means the cache hasn't finished refreshing
{ update progress bar code goes here - estimated }
DoEvents ' Cache wouldn't start refreshing without this code
GoTo RefreshCache:
End If
Next pv
Next sh

End Sub

As indicated by the curly brackets, I estimate the progress of the progress bar (according to the time already passed), as I don't know of any way to determine the exact number of records that have been refreshed in the middle of refreshing the cache.

In any case, the above code doesn't work - it starts refreshing the cache (the revolving world symbol appears at the bottom of the window) but just won't finish refreshing the first cache. After a couple of minutes, if I double click the world symbol, it says "All rows fetched.", but doesn't start refreshing the next cache.

Does anyone have any suggestions why the second block of code above doesn't work, and what alternative code might work to end up with a progress bar that moves gradually up to 20 black squares?

Tim :help

10-12-2009, 05:39 AM

10-12-2009, 06:13 PM
Shot in the dark, but what happens if you put a DoEvents after the pc.Refresh line?

I'd be surprised if there's any way to process while the .Refresh is executing, so maybe updating after each pivot cache is refreshed would work. Would not be smooth since the size of the pivot chaches vary, but might work