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.
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
Text boxes in worksheets are sometimes not updated
when their text or formatting is changed, and even
the DoEvent command does not help.
As there is no command in Excel to refresh a worksheet
in the way a user form can be refreshed, it is necessary
to use a trick to force Excel to update the screen.
The following commands seem to do the trick:
- ActiveSheet.Calculate
- ActiveWindow.SmallScroll
- Application.WindowState = Application.WindowState
Put a call to DoEvents in the loop.
This will affect performance, so you might want to only call it on each, say, 10th iteration.
However, if you only have 30, that's hardly an issue.
#Hubisans comment worked best for me.
ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1
Specifically, if you are dealing with a UserForm, then you might try the Repaint method. You might encounter an issue with DoEvents if you are using event triggers in your form. For instance, any keys pressed while a function is running will be sent by DoEvents The keyboard input will be processed before the screen is updated, so if you are changing cells on a spreadsheet by holding down one of the arrow keys on the keyboard, then the cell change event will keep firing before the main function finishes.
A UserForm will not be refreshed in some cases, because DoEvents will fire the events; however, Repaint will update the UserForm and the user will see the changes on the screen even when another event immediately follows the previous event.
In the UserForm code it is as simple as:
Me.Repaint
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
This is not directly answering your question at all, but simply providing an alternative. I've found in the many long Excel calculations most of the time waiting is having Excel update values on the screen. If this is the case, you could insert the following code at the front of your sub:
Application.ScreenUpdating = False
Application.EnableEvents = False
and put this as the end
Application.ScreenUpdating = True
Application.EnableEvents = True
I've found that this often speeds up whatever code I'm working with so much that having to alert the user to the progress is unnecessary. It's just an idea for you to try, and its effectiveness is pretty dependent on your sheet and calculations.
On a UserForm two things worked for me:
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
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
I have this piece of code which I would like to show and hide some Shape objects one by one, in order to make a little animation. However, nothing happens as the code executes, all images are shown by once when the code stops running.
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
Sleep 500
'Sheets("Game").Shapes("North" & i).Visible = False
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
DoEvents
Next i
End Sub
DoEvents allows other code (e.g. Excel's own) to run and handle things like user clicking on another worksheet (which invokes any Worksheet.Change or Workbook.WorksheetChange handler)... or just repainting itself.
By invoking DoEvents once per loop, Excel doesn't get a chance to repaint between the visibility toggles: it's already busy running your loop.
So you need to toggle visibility on, let Excel repaint (DoEvents), sleep for your animation delay (500ms seems a tad slow IMO), then toggle visibility off and let Excel repaint again, i.e. invoke DoEvents one more time.
If the Game worksheet is in ThisWorkbook, then I'd warmly recommend you give it a CodeName - select it in the Project Explorer, then look at its properties (F4) and change its (Name) to, say, GameSheet.
This gives you a global-scope object variable so that you don't need to dereference the same worksheet twice per iteration - heck you could even dereference its Shapes collection only once:
Private Const ANIMATION_DELAY As Long = 100
Sub test()
With GameSheet.Shapes
For i = 1 To 4
Dim currentShape As Shape
Set currentShape = .Item("North" & i)
currentShape.Visible = True
DoEvents
Sleep ANIMATION_DELAY
currentShape.Visible = False
DoEvents
Debug.Print i
Next
End With
End Sub
Amended the code by setting DoEvents after toggling True and Falseand now it works:
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
DoEvents
Sleep 100
Sheets("Game").Shapes("North" & i).Visible = False
DoEvents
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
Next i
End Sub
I have some vba code that takes a good minute or so to run in excel and I was trying to add a progress bar or some type of waiting screen to better show to the user that the code is still running correctly. I realize that the ProgressBar can only show true progress in specific types of code, of which I do not believe mine would apply.
However, I was wondering if there was a way to have the ProgressBar just loop and once it is full it starts from the beginning again until my code has finished; in a similar fashion to a charging icon when a phone is plugged in. So upon activating my code, the UserForm1 would pop up and show a repeating ProgressBar and upon completion of my code the UserForm would Unload.
Any suggestions would be helpful.
Thanks!
I use the following for a progress bar on a user form. It consists of a label within a frame; at the beginning the label has width zero and then it widens to fill the frame at 100% completion. The label has no text, but it has a BackColor property set to serve as the bar. There's a second progressText label to the right of the frame. To call this function, use a loop such as i = i + 1 with pctCompl = 100 * i / iTotalNum, and then include in the loop: progress pctCompl, "listing files", and when finished make progress bar invisible with: progress -1. You can always reset it to 0 using pctCompl = 0 at any time.
Sub progress(pctCompl As Integer, Optional msg As String)
Dim increment As Double, i As Integer
If pctCompl < 0 Then
If progressBar.Width < 0.9 * progressFrame.Width Then
progressBar.Width = progressFrame.Width
Application.Wait (Now + TimeValue("0:00:01"))
End If
progressText.Visible = False
progressFrame.Visible = False
Exit Sub
Else
progressText.Visible = True
progressFrame.Visible = True
End If
progressText.Caption = pctCompl & "% " & msg
progressBar.Width = progressFrame.Width * pctCompl / 100
DoEvents
End Sub
Private Sub UserForm_Activate()
progressFrame.Visible = False
progressText.Visible = False
end Sub
I want to allow the user to make a selection, run some code, pause for another selection, run more code?
I work with documents with large number of tables that eventually convert to HTML. Sometimes the formatting on two like tables doesn't convert the same. Knowing how the converter works, I'd like to copy all of the formatting data from one table and "paste" it onto another one.
I've the idea of a userform to have the user select something, hit a copy button, select something else and hit a paste button.
The timer function allows you to do this. It may not be the best way to code, but it is the answer to your problem:
'1st code here
Start = Timer
Do While Timer < Start + 10
DoEvents
Loop
'do 2nd code here
DoEvents allows the user to select text, etc. After 10 seconds, the code resumes at "2nd code."
You can use global a global variable:
Public myVar as Variant
Sub fillmyVar()
myVar = Selection
End Sub
Sub doSth()
' use myVar and the new selected text
End Sub
Using the answer from Aaron and incorporating it with a ToggleButton in the Userform you can successfully pause the code. With this you can then work in an additional selection to change the operation.
I originally did not use Global or Public Variables but soon learnt that its easier for passing data between Subs and Userforms
Userform:
Public Sub ToggleButton1_AfterUpdate()
'Program is Paused / Selected to Pause
If ProgBar.ToggleButton1.Value = True Then
'Changing the Text of the Toggle button once the program is selected to Pause
'If program paused then button will display continue
ProgBar.ToggleButton1.Caption = "Continue"
'For Sending to Loop Code
ProgramStatus = "0"
Call LoopCode.PrgStat(ProgramStatus)
End If
'Program is running / Selected to run
If ProgBar.ToggleButton1.Value = False Then
'Changing the Text of the Toggle button once the program is selected to continue
'If program running then button will display pause
ProgBar.ToggleButton1.Caption = "Pause"
'For Sending to Loop Code
ProgramStatus = "1"
Call LoopCode.PrgStat(ProgramStatus)
End If
End Sub
In your Module
Public Status As String
Public Sub PrgStat(ByVal ProgStatus As String)
Status = ProgStatus
End Sub
Sub SomeSub()
Do While
' Some Loop Code Running
If Status = "1" Then
'Toggle Not Pressed
End If
If Status = "0" Then
'Toggle Button Pressed
Do While Status = "0"
'Program will stop here until the togglebutton on the
'userform is pressed again which changes Status = 1
'This is where you can make another selection on the
'userform
DoEvents
Loop
End If
Loop
End Sub
On my form I have one button (button1). When I click this button it starts my app. My app is meant to loop forever. Is there a way for my app to click button1 on the 20th loop?
Here is an example of my app:
**Click button1**
webbrowser.navigate("")
looping:
'some code
'some code
goto looping:
You'd need a variable to use as a counter, and increment it each time through the loop. During each loop iteration you can test the value of the variable, and if it's equal to 20 then fire the click event on the button.
I'm not sure if this is what you want, but perhaps this will get you started.
Dim i as Integer =1
Do
If i = 20 Then
Call Button_Click(Nothing, Nothing)
ElseIf i<=20
i+=1
End If
If shouldExit Then 'some other condition to break out.
Exit Do
End If
Loop While True