vbaexcel

Force a screen update in Excel VBA


My Excel tool performs a long task, and I'm trying to be kind to the user by providing a progress report in the status bar, or in some cell in the sheet, as shown below. But the screen doesn't refresh, or stops refreshing at some point (e.g. 33%). The task eventually completes but the progress bar is useless.

What can I do to force a screen update?

For i=1 to imax ' imax is usually 30 or so
    fractionDone=cdbl(i)/cdbl(imax)
    Application.StatusBar = Format(fractionDone, "0%") & "done..."
    ' or, alternatively:
    ' statusRange.value = Format(fractionDone, "0%") & "done..."

    ' Some code.......

Next i

I'm using Excel 2003.


Solution

  • Add a DoEvents function inside the loop, see below.

    You may also want to ensure that the Status bar is visible to the user and reset it when your code completes.

    Sub ProgressMeter()
    
    Dim booStatusBarState As Boolean
    Dim iMax As Integer
    Dim i As Integer
    
    iMax = 10000
    
        Application.ScreenUpdating = False
    ''//Turn off screen updating
    
        booStatusBarState = Application.DisplayStatusBar
    ''//Get the statusbar display setting
    
        Application.DisplayStatusBar = True
    ''//Make sure that the statusbar is visible
    
        For i = 1 To iMax ''// imax is usually 30 or so
            fractionDone = CDbl(i) / CDbl(iMax)
            Application.StatusBar = Format(fractionDone, "0%") & " done..."
            ''// or, alternatively:
            ''// statusRange.value = Format(fractionDone, "0%") & " done..."
            ''// Some code.......
    
            DoEvents
            ''//Yield Control
    
        Next i
    
        Application.DisplayStatusBar = booStatusBarState
    ''//Reset Status bar display setting
    
        Application.StatusBar = False
    ''//Return control of the Status bar to Excel
    
        Application.ScreenUpdating = True
    ''//Turn on screen updating
    
    End Sub