Force a screen update in Excel VBA

Viewed 181105

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.

11 Answers

@Hubisans comment worked best for me.

ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1

This worked for me:

ActiveWindow.SmallScroll down:=0

or more simply:

ActiveWindow.SmallScroll 0

I couldn't gain yet the survey of an inherited extensive code. And exact this problem bugged me for months. Many approches with DoEnvents were not helpful. Above answer helped. Placeing this Sub in meaningful positions in the code worked even in combination with progress bar

Sub ForceScreenUpdate()
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Wait Now + #12:00:01 AM#
    Application.ScreenUpdating = False
    Application.EnableEvents = False
End Sub

On a UserForm two things worked for me:

  1. I wanted a scrollbar in my form on the left. To do that, I first had to add an Arabic language to "Change administrative language" in the Language settings of Windows 10 (Settings->Time & Language->Change Administrative Language). The setting is actually for "Change the language of Non-Unicode Programs," which I changed to Arabic (Algerian). Then in the properties of the form I set the "Right to Left" property to True. From there the form still drew a partial ghost right scrollbar at first, so I also had to add an unusual timed message box:
    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 1
    Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
    Case 1, -1
    End Select
  1. I tried everything to get the screen to redraw again to show the first text box in it's proper alignment in the form, instead of partially underneath or at least immediately adjacent to the scrollbar instead of 4 pixels to the right where I wanted it. Finally I got this off another Stackoverflow post (which I now can't find or I would credit it) that worked like a charm:
Me.Frame1.Visible = False
Me.Frame1.Visible = True

In my case the problem was in trying to make one shape visible and another one invisible on a worksheet.

This is my approach to "inactivating" a button [shape] once the user has clicked it. The two shapes are the same size and in the same place, but the "inactive" version has dimmer colors, which was a good approach, but it didn't work, because I could never get the screen to update after changing .visible = FALSE to = TRUE and vice versa.

None of the relevant tricks in this thread worked. But today I found a solution that worked for me, at this link on Reddit

Essentially you just call DoEvents twice in immediate succession after the code that makes the changes. Now why? I can't say, but it did work.

I've been trying to solve this Force a screen update on a Worksheet (not a userform) for many years with limited success with doevents and scrolling etc.. This CH Oldie solutions works best with a slight mod.

I took out the Wait and reset ScreenUpdating and EnableEvents back to true.

This works office excel 2002 through to office 365

Sub Sheet1Mess(Mess1 As String)
    Sheet1.Range("A6").Value = Mess1
    ForceScreenUpdate
End Sub
Sub ForceScreenUpdate()
    Application.ScreenUpdating = True
    Application.EnableEvents = True
   ' Application.Wait Now + #12:00:01 AM#
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Related