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
Related
I want to use the statusbar for update Information during long calculations in Word. However, the statusbar flickers and switches back to the "normal" statusbar during calculations.
Example:
Sub main()
Dim i As Integer
Dim j As Long
Dim dummy As Double
For i = 1 To 100
Application.StatusBar = "Please be patient... i=" & i
' waiting loop: Flickering due to calculations
For j = 1 To 90000
dummy = Sqr(j) ^ 3
dummy = Sqr(dummy)
Next
' just waiting: (almost) No flickering
'CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))
Next
Application.StatusBar = False
End Sub
If you change the waiting loop with the commended CreateObject..., the flickering is almost gone. I tried also Application.ScreenUpdating but it doesn't work.
How can I stop the flickering during the calculations?
The status bar is flickering because you’ve including its updating in the loop. In effect, it repaints itself on each iteration.
Move it out of the loop and then obviously don’t include the variable “i”.
Another workaround is to put a condition in the loop that checks the counter and only repaints the status bar at 25% done, 50% done and 75% done time frames.
I am trying to work out how to get my progress bar to show the progress of the subroutine below. Does anyone have any ideas how to get the ball rolling on this one?
Any help or advice is appreciated.
Private Sub CommandButton8_Click()
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Direct Data
Sheet4.Activate
Call Test1
Call Test2
Call Test3
Call Test4
'Return to Welcome Page
Sheet8.Activate
'*****************************
'Determine how many seconds the code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
vbInformation
End Sub
Here's what I use for a progress bar:
Application.StatusBar = "Processing... " & CInt(nRow / nLastRow * 100) & "% " & String(CInt(nRow / nLastRow * 100), ChrW(9609))
DoEvents ' optional
nRow is the increment number
nLastRow is the value for 100% complete
When the loop is complete, reset it like this:
Application.StatusBar = ""
The logic behind a progressbar is this:
have a userform with a Label (or image or button) with the image of your example photo. Put it in a frame. The width of the frame is initialised to zero and grows as your number grows by either calling a Public Sub inside the userform, of directly Userform1.Frame1.width=Percent*MaxWidth/100.
Sometime you would want to add a doevents, wich i use only every X cycles (if clng(percent) mod X = 0 then doevents , for example).
Step 1: design a progress dialog box. For the following example, it must have the name frmProgress and have two text labels lblMsg1 and lblMsg2
Step 2: insert the following code in the dialog's code module:
Sub ShowProgressBox()
Me.Show vbModeless
End Sub
Sub SetProgressMsg(msg1, msg2)
If (msg1 <> "") Then Me.lblMsg1 = msg1
If (msg2 <> "") Then Me.lblMsg2 = msg2
DoEvents
End Sub
Sub SetProgressTitle(title)
Me.Caption = title
DoEvents
End Sub
Sub EndProgressBox()
Unload Me
End Sub
You can call these functions from your code to show progress messages.
Step 3: in your code, at the beginning of the lengthy operation, call
frmProgress.ShowProgressBox
Step 4: during the lengthy operation, regularly call the set function to show the user information, for example in a loop:
frmProgress.SetProgressMsg "Searching in "+ myArray(i), "Working..."
Step 5: Once done, close the progress box:
frmProgress.EndProgressBox
I'm trying to change the text displayed in the status bar in Excel 2015 using VBA. However, it doesn't seem to be updated. The message "Ready" remains there.
Function testStatusBar(delay As Long)
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
End Function
I also tried many answers that where given here on this website for similar questions, however nothing worked. Is something wrong with the code or do I have to change some settings?
Your function works fine, but I suspect that you are calling it as a UDF from an Excel cell. UDFs are not permitted to update the status bar, or make any other changes to the Excel environment. (Basically, a UDF is allowed to return a value and that's it.)
If you called that function from a piece of VBA code, it works OK, providing you change it to return a value such as:
Function testStatusBar(delay As Long) As String
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
testStatusBar = "Finished"
End Function
(You could then call it from other VBA code by saying myReturnValue = testStatusBar(200000)
Or change it to a Sub instead of a Function, i.e.
Sub testStatusBar(delay As Long)
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
End Sub
(and then call it by saying testStatusBar 200000.)
I am really sorry if this is a silly question. I would like to display a message box similar to the Immediate window that will sit "always on top" and scroll a countdown while not interrupting the VBA program.
I am essentially crunching numbers for 40,000 rows and each run takes about 15 minutes. I don't know if it's still running or when the current VBA code will complete.
Does anyone have suggestions?
Use the status bar:
Application.StatusBar = "Row " & rowNum & " of " & rowCount
At the end, to clear the status bar:
Application.StatusBar = False
You can do it by displaying modeless user form. Below is an example how to do this.
In order to make this example working properly you need to add new, empty UserForm to your project and change it name to frmProgress.
Sub test()
Dim form As frmProgress
Dim lblProgress As Object
Dim i As Long
'-------------------------------------------------
'Create an instance of user form and show it modeless on the screen.
Set form = New frmProgress
With form
.Width = 200
.Height = 60
.Caption = "Progress"
'Add label for displaying text...
Set lblProgress = .Controls.Add("Forms.Label.1", "lblProgress")
'... and format it to meet your requirements.
With lblProgress
.Width = 200
.Height = 60
.TextAlign = fmTextAlignCenter
.Font.Size = 12
.Top = 6
End With
Call .Show(vbModeless)
End With
For i = 1 To 100000
'(Some code ...)
DoEvents
'Here the new text is inserted on the message box.
lblProgress.Caption = i
Next i
Call form.Hide
End Sub
I have some long processes that require notifications to the user at successive stages, so that he doesn't get to believe Excel has crashed down.
How could I display asynchronous messages to the user in Excel, using VBA ?
You can use the status bar in Excel to do this:
Application.StatusBar = "status message"
Here is an example on how to implement this: http://www.vbaexpress.com/kb/getarticle.php?kb_id=87
Below is the code from the site (added line break to make is easier to read):
Sub StatusBar()
Dim x As Integer
Dim MyTimer As Double
'Change this loop as needed.
For x = 1 To 250
'Dummy Loop here just to waste time.
'Replace this loop with your actual code.
MyTimer = Timer
Do
Loop While Timer - MyTimer < 0.03
Application.StatusBar = _
"Progress: " & x & " of 250: " & Format(x / 250, "Percent")
DoEvents
Next x
Application.StatusBar = False
End Sub
UPDATE:
I do want to add that updating the status bar will result in a sizable hit in performance (quite a bit actually), so you should only update it in approriate intervals. Here's an example of what I mean (I use MOD here to ensure we only increment each 1000):
Sub test()
Dim i As Long
Dim temp As String
For i = 1 To 1000000
temp = "testing 123, testing 123"
If i Mod 1000 = 0 Then
Application.StatusBar = "Processing " & i & "/1,000,000..."
End If
Next
Application.StatusBar = "Ready"
End Sub
Also note that you want to reset the text to "Ready" otherwise it'll be left as if it were in the loop.
I've stuck with Walkenbach's progress form for my addins
The following article has a number of ways of doing this: http://oreilly.com/pub/h/2607
I think the best bet for you would be to show a progress form. This can include a progress bar and text updates to reassure the user.
Something I once did was to create an extra tab called "Running".
After each time consuming loop, I add the following code with updated text information.
Although the text sometimes changes too fast, the changing color bar shows the user that the script is still running. You have to define AlertColor first with a value of 6.
Sheets("Running").Select 'Show the running page
Range("B18").Value = "Importing ABC......"
Cells(18, 2).Interior.ColorIndex = AlertColour
AlertColour = AlertColour + 1
If AlertColour > 8 Then AlertColour = 6
Application.ScreenUpdating = True
Application.ScreenUpdating = False
I don't know how far you want to go with your solution, but you can utilise RTD function. That way you could put a status message directly in the worksheet. But it would require development of a COM Automation server, which is not complicated (can be written in .NET or VB6 or C++ or Delphi), but causes problems once in production (deployment, support, code control etc.)