Progress Bar for refreshing pivot caches

[timqld]

Hi,

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
        pc.Refresh
        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
 
RefreshCache:
            pc.Refresh
            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

[bruinenat]

damn

[Paul_Hossler]

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

Paul