How can I create a progress bar in Excel VBA?

Question

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.

Answer 1

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 

Answer 2

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