I'm doing an Excel app that needs a lot data updating from a database, so it takes time. I want to make a progress bar in a userform and it pops up when the data is updating. The bar I want is just a little blue bar moves right and left and repeats till the update is done, no percentage needed.
I know I should use the progressbar
control, but I tried for sometime, but can't make it.
My problem is with the progressbar
control, I can't see the bar 'progress'. It just completes when the form pops up. I use a loop and DoEvent
but that isn't working. Plus, I want the process to run repeatedly, not just one time.
I liked the Status Bar from this page:
https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/
I updated it so it could be used as a called procedure. No credit to me.
showStatus Current, Total, " Process Running: "
Private Sub showStatus(Current As Integer, lastrow As Integer, Topic As String)
Dim NumberOfBars As Integer
Dim pctDone As Integer
NumberOfBars = 50
'Application.StatusBar = "[" & Space(NumberOfBars) & "]"
' Display and update Status Bar
CurrentStatus = Int((Current / lastrow) * NumberOfBars)
pctDone = Round(CurrentStatus / NumberOfBars * 100, 0)
Application.StatusBar = Topic & " [" & String(CurrentStatus, "|") & _
Space(NumberOfBars - CurrentStatus) & "]" & _
" " & pctDone & "% Complete"
' Clear the Status Bar when you're done
' If Current = Total Then Application.StatusBar = ""
End Sub
Hi modified version of another post by Marecki. Has 4 styles
1. dots ....
2 10 to 1 count down
3. progress bar (default)
4. just percentage.
Before you ask why I didn't edit that post is I did and it got rejected was told to post a new answer.
Sub ShowProgress()
Const x As Long = 150000
Dim i&, PB$
For i = 1 To x
DoEvents
UpdateProgress i, x
Next i
Application.StatusBar = ""
End Sub 'ShowProgress
Sub UpdateProgress(icurr As Long, imax As Long, Optional istyle As Integer = 3)
Dim PB$
PB = Format(icurr / imax, "00 %")
If istyle = 1 Then ' text dots >>.... <<'
Application.StatusBar = "Progress: " & PB & " >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
ElseIf istyle = 2 Then ' 10 to 1 count down (eight balls style)
Application.StatusBar = "Progress: " & PB & " " & ChrW$(10111 - Val(PB) / 11)
ElseIf istyle = 3 Then ' solid progres bar (default)
Application.StatusBar = "Progress: " & PB & " " & String(100 - Val(PB), ChrW$(9608))
Else ' just 00 %
Application.StatusBar = "Progress: " & PB
End If
End Sub
I'm loving all the solutions posted here, but I solved this using Conditional Formatting as a percentage-based Data Bar.
This is applied to a row of cells as shown below. The cells that include 0% and 100% are normally hidden, because they're just there to give the "ScanProgress" named range (Left) context.
In the code I'm looping through a table doing some stuff.
For intRow = 1 To shData.Range("tblData").Rows.Count
shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
DoEvents
' Other processing
Next intRow
Minimal code, looks decent.
Here's another example using the StatusBar as a progress bar.
By using some Unicode Characters, you can mimic a progress bar. 9608 - 9615 are the codes I tried for the bars. Just select one according to how much space you want to show between the bars. You can set the length of the bar by changing NUM_BARS. Also by using a class, you can set it up to handle initializing and releasing the StatusBar automatically. Once the object goes out of scope it will automatically clean up and release the StatusBar back to Excel.
' Class Module - ProgressBar
Option Explicit
Private statusBarState As Boolean
Private enableEventsState As Boolean
Private screenUpdatingState As Boolean
Private Const NUM_BARS As Integer = 50
Private Const MAX_LENGTH As Integer = 255
Private BAR_CHAR As String
Private SPACE_CHAR As String
Private Sub Class_Initialize()
' Save the state of the variables to change
statusBarState = Application.DisplayStatusBar
enableEventsState = Application.EnableEvents
screenUpdatingState = Application.ScreenUpdating
' set the progress bar chars (should be equal size)
BAR_CHAR = ChrW(9608)
SPACE_CHAR = ChrW(9620)
' Set the desired state
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Private Sub Class_Terminate()
' Restore settings
Application.DisplayStatusBar = statusBarState
Application.ScreenUpdating = screenUpdatingState
Application.EnableEvents = enableEventsState
Application.StatusBar = False
End Sub
Public Sub Update(ByVal Value As Long, _
Optional ByVal MaxValue As Long= 0, _
Optional ByVal Status As String = "", _
Optional ByVal DisplayPercent As Boolean = True)
' Value : 0 to 100 (if no max is set)
' Value : >=0 (if max is set)
' MaxValue : >= 0
' Status : optional message to display for user
' DisplayPercent : Display the percent complete after the status bar
' <Status> <Progress Bar> <Percent Complete>
' Validate entries
If Value < 0 Or MaxValue < 0 Or (Value > 100 And MaxValue = 0) Then Exit Sub
' If the maximum is set then adjust value to be in the range 0 to 100
If MaxValue > 0 Then Value = WorksheetFunction.RoundUp((Value * 100) / MaxValue, 0)
' Message to set the status bar to
Dim display As String
display = Status & " "
' Set bars
display = display & String(Int(Value / (100 / NUM_BARS)), BAR_CHAR)
' set spaces
display = display & String(NUM_BARS - Int(Value / (100 / NUM_BARS)), SPACE_CHAR)
' Closing character to show end of the bar
display = display & BAR_CHAR
If DisplayPercent = True Then display = display & " (" & Value & "%) "
' chop off to the maximum length if necessary
If Len(display) > MAX_LENGTH Then display = Right(display, MAX_LENGTH)
Application.StatusBar = display
End Sub
Sample Usage:
Dim progressBar As New ProgressBar
For i = 1 To 100
Call progressBar.Update(i, 100, "My Message Here", True)
Application.Wait (Now + TimeValue("0:00:01"))
Next
There have been many other great posts, however I'd like to say that theoretically you should be able to create a REAL progress bar control:
CreateWindowEx()
to create the progress barA C++ example:
hwndPB = CreateWindowEx(0, PROGRESS_CLASS, (LPTSTR) NULL, WS_CHILD | WS_VISIBLE, rcClient.left,rcClient.bottom - cyVScroll,rcClient.right, cyVScroll,hwndParent, (HMENU) 0, g_hinst, NULL);
hwndParent
Should be set to the parent window. For that one could use the status bar, or a custom form! Here's the window structure of Excel found from Spy++:
This should therefore be relatively simple using FindWindowEx()
function.
hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar")
After the progress bar has been created you must use SendMessage()
to interact with the progress bar:
Function MAKELPARAM(ByVal loWord As Integer, ByVal hiWord As Integer)
Dim lparam As Long
MAKELPARAM = loWord Or (&H10000 * hiWord)
End Function
SendMessage(hwndPB, PBM_SETRANGE, 0, MAKELPARAM(0, 100))
SendMessage(hwndPB, PBM_SETSTEP, 1, 0)
For i = 1 to 100
SendMessage(hwndPB, PBM_STEPIT, 0, 0)
Next
DestroyWindow(hwndPB)
I'm not sure how practical this solution is, but it might look somewhat more 'official' than other methods stated here.
============== This code goes in Module1 ============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Create a Button on a Worksheet; map button to "ShowProgress" macro
Create a UserForm1 with 2 buttons, progress bar, bar box, text box:
UserForm1 = canvas to hold other 5 elements
CommandButton2 = Run Progress Bar Code; Caption:Run
CommandButton1 = Close UserForm1; Caption:Close
Bar1 (label) = Progress bar graphic; BackColor:Blue
BarBox (label) = Empty box to frame Progress Bar; BackColor:White
Counter (label) = Display the integers used to drive the progress bar
======== Attach the following code to UserForm1 =========
Option Explicit
' This is used to create a delay to prevent memory overflow
' remove after software testing is complete
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub UserForm_Initialize()
Bar1.Tag = Bar1.Width
Bar1.Width = 0
End Sub
Sub ProgressBarDemo()
Dim intIndex As Integer
Dim sngPercent As Single
Dim intMax As Integer
'==============================================
'====== Bar Length Calculation Start ==========
'-----------------------------------------------'
' This section is where you can use your own '
' variables to increase bar length. '
' Set intMax to your total number of passes '
' to match bar length to code progress. '
' This sample code automatically runs 1 to 100 '
'-----------------------------------------------'
intMax = 100
For intIndex = 1 To intMax
sngPercent = intIndex / intMax
Bar1.Width = Int(Bar1.Tag * sngPercent)
Counter.Caption = intIndex
'======= Bar Length Calculation End ===========
'==============================================
DoEvents
'------------------------
' Your production code would go here and cycle
' back to pass through the bar length calculation
' increasing the bar length on each pass.
'------------------------
'this is a delay to keep the loop from overrunning memory
'remove after testing is complete
Sleep 10
Next
End Sub
Private Sub CommandButton1_Click() 'CLOSE button
Unload Me
End Sub
Private Sub CommandButton2_Click() 'RUN button
ProgressBarDemo
End Sub
================= UserForm1 Code Block End =====================
============== This code goes in Module1 =============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Sub ShowProgress()
' Author : Marecki
Const x As Long = 150000
Dim i&, PB$
For i = 1 To x
PB = Format(i / x, "00 %")
Application.StatusBar = "Progress: " & PB & " >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
Application.StatusBar = "Progress: " & PB & " " & ChrW$(10111 - Val(PB) / 11)
Application.StatusBar = "Progress: " & PB & " " & String(100 - Val(PB), ChrW$(9608))
Next i
Application.StatusBar = ""
End SubShowProgress
You can create a form in VBA, with code to increase the width of a label control as your code progresses. You can use the width property of a label control to resize it. You can set the background colour property of the label to any colour you choose. This will let you create your own progress bar.
The label control that resizes is a quick solution. However, most people end up creating individual forms for each of their macros. I use the DoEvents function and a modeless form to use a single form for all your macros.
Here is a blog post I wrote about it: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/
All you have to do is import the form and a module into your projects, and call the progress bar with: Call modProgress.ShowProgress(ActionIndex, TotalActions, Title.....)
I hope this helps.
About the progressbar
control in a userform, it won't show any progress if you don't use the repaint
event. You have to code this event inside the looping (and obviously increment the progressbar
value).
Example of use:
userFormName.repaint
You can add a Form and name it as Form1, add a Frame to it as Frame1 as well as Label1 too. Set Frame1 width to 200, Back Color to Blue. Place the code in the module and check if it helps.
Sub Main()
Dim i As Integer
Dim response
Form1.Show vbModeless
Form1.Frame1.Width = 0
For i = 10 To 10000
With Form1
.Label1.Caption = Round(i / 100, 0) & "%"
.Frame1.Width = Round(i / 100, 0) * 2
DoEvents
End With
Next i
Application.Wait Now + 0.0000075
Unload Form1
response = MsgBox("100% Done", vbOKOnly)
End Sub
If you want to display on the Status Bar then you can use other way that's simpler:
Sub Main()
Dim i As Integer
Dim response
For i = 10 To 10000
Application.StatusBar = Round(i / 100, 0) & "%"
Next i
Application.Wait Now + 0.0000075
response = MsgBox("100% Done", vbOKOnly)
End Sub
Just adding my part to the above collection.
If you are after less code and maybe cool UI. Check out my GitHub for Progressbar for VBA
a customisable one:
The Dll is thought for MS-Access but should work in all VBA platform with minor changes. There is also an Excel file with samples. You are free to expand the vba wrappers to suit your needs.
This project is currently under development and not all errors are covered. So expect some!
You should be worried about 3rd party dlls and if you are, please feel free to use any trusted online antivirus before implementing the dll.
Sometimes a simple message in the status bar is enough:
This is very simple to implement:
Dim x As Integer
Dim MyTimer As Double
'Change this loop as needed.
For x = 1 To 50
' Do stuff
Application.StatusBar = "Progress: " & x & " of 50: " & Format(x / 50, "0%")
Next x
Application.StatusBar = False
Source: Stackoverflow.com