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

I know this is an old thread, but I use the following, which is similar to a couple of the above posts, but displays an icon of your choosing which moves along the progress bar.

I use it a lot when looping through a recordset where I know the current position and the number of records (eg. exporting a large range to a database)

Just post into a new module in VBA and call it before .MoveNext in a recordset loop...

Just remember to capture the current StatusBar value before your start the loop, and reset it afterwards, or set it back to "Ready" :)

Option Explicit

Public Enum sbIcon
    SBPlane = 9992
    SBBoat = 9973
    SBTruck = 9951
    SBBBall = 9918
End Enum

Public Sub myStatusBar(dbPos As Double, dbMax As Double, lngBars As Long, 
sMessage As String, sbIcon As sbIcon)
'Usage
'dbPos = current position in the process
'dbMax = Total number of records
'lngBars = how many bars/squares to show in total
'sMessage = text to show alongside progess bar
'icon = pick one of the icons to show the progress - eg. truck, baseball, boat, plane

'e.g. myStatusBar 25, 100,50,"Records processed", SBBBALL

Dim n As Double
Dim sComp As String, sPend As String
Dim dPc As Double

    sComp = ""
    sPend = ""

    dPc = Round((dbPos / dbMax) * lngBars) 'how many steps/squares are to be filled in

    For n = 1 To dPc - 1
        sComp = sComp & ChrW(9635) 'Construct the string to show completed status (filled square)
    Next

    sComp = sComp & ChrW(sbIcon) 'add truck icon

    n = lngBars - dPc 'Calculate how many more characters are required to show the uncompleted part of the process

    For n = 1 To n 'Loop through adding the character to show uncompleted (empty square)
        sPend = sPend & ChrW(9634)
    Next

    Application.StatusBar = sComp & sPend & " " & Format(dbPos / dbMax, "Percent") & " " & sMessage 'Update Status Bar to show constructed string
    DoEvents
End Sub


Sub test()
Dim n As Double

For n = 1 To 1100
    myStatusBar n, 1100, 50, "Data transferred", sBBoat
Next n
End Sub

Feel free to adapt to meet your own needs

Answer 2

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.

Call 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

Answer 3

I know this is an old thread but I had asked a similar question not knowing about this one. I needed an Excel VBA Progress Bar and found this link: Excel VBA StatusBar. Here is a generalized version that I wrote. There are 2 methods, a simple version DisplaySimpleProgressBarStep that defaults to '[|| ] 20% Complete' and a more generalized version DisplayProgressBarStep that takes a laundry list of optional arguments so that you can make it look like just about anything you wish.

    Option Explicit
    
    ' Resources
    '   ASCII Chart: https://vbaf1.com/ascii-table-chart/
    
    Private Enum LabelPlacement
        None = 0
        Prepend
        Append
    End Enum
    
    #If VBA7 Then
     Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
    #Else
     Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
    #End If
    
    Public Sub Test()
        Call ProgressStatusBar(Last:=10)
    End Sub
    
    Public Sub Test2()
    Const lMilliseconds As Long = 500
    Dim lIndex As Long, lNumberOfBars As Long
    Dim sBarChar As String
        sBarChar = Chr$(133) ' Elipses …
        sBarChar = Chr$(183) ' Middle dot ·
        sBarChar = Chr$(176) ' Degree sign °
        sBarChar = Chr$(171) ' Left double angle «
        sBarChar = Chr$(187) ' Right double angle »
        sBarChar = Chr$(166) ' Broken vertical bar ¦
        sBarChar = Chr$(164) ' Currency sign ¤
        sBarChar = Chr$(139) ' Single left-pointing angle quotation mark ‹
        sBarChar = Chr$(155) ' Single right-pointing angle quotation mark ›
        sBarChar = Chr$(149) ' Bullet •
        sBarChar = "|"
        
        For lIndex = 1 To 10
            Call DisplayProgressBarStep(lIndex, 10, 50, LabelPlacement.Append, sBarChar)
            Call Sleep(lMilliseconds)
        Next
        Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2 Completed")
        Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
    End Sub
    
    Public Sub Test2Simple()
    Const lMilliseconds As Long = 500
    Dim lIndex As Long, lNumberOfBars As Long
        For lIndex = 1 To 10
            Call DisplayProgressBarStep(lIndex, 10, 50)
            Call Sleep(lMilliseconds)
        Next
        Call MsgBox("Status bar test completed.", vbOKOnly Or vbInformation, "Test2Simple Completed")
        Call DisplayProgressBarStep(lIndex, 10, bClearStatusBar:=True)
    End Sub
    
    ''' <summary>
    ''' Method to display an Excel ProgressBar. Called once for each step in the calling code process.
    ''' Defaults to vertical bar surrounded by square brackets with a trailing percentage label (e.g. [|||||] 20% Complete).
    '''
    ''' Adapted
    ''' From: Excel VBA StatusBar
    ''' Link: https://www.wallstreetmojo.com/vba-status-bar/
    ''' </summary>
    ''' <param name="Step">The current step count.</param>
    ''' <param name="StepCount">The total number of steps.</param>
    ''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
    ''' <param name="LabelPlacement">Optional, Can be None, Prepend or Append. Defaults to Append.</param>
    ''' <param name="BarChar">Optional, Character that makes up the horizontal bar. Defaults to | (Pipe).</param>
    ''' <param name="PrependedBoundaryText">Optional, Boundary text prepended to the StatusBar. Defaults to [ (Left square bracket).</param>
    ''' <param name="AppendedBoundaryText">Optional, Boundary text appended to the StatusBar. Defaults to ] (Right square bracket).</param>
    ''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
    Private Sub DisplayProgressBarStep( _
        lStep As Long, _
        lStepCount As Long, _
        Optional lNumberOfBars As Long = 0, _
        Optional eLabelPlacement As LabelPlacement = LabelPlacement.Append, _
        Optional sBarChar As String = "|", _
        Optional sPrependedBoundaryText As String = "[", _
        Optional sAppendedBoundaryText As String = "]", _
        Optional bClearStatusBar As Boolean = False _
        )
    Dim lCurrentStatus As Long, lPctComplete As Long
    Dim sBarText As String, sLabel As String, sStatusBarText As String
        If bClearStatusBar Then
            Application.StatusBar = False
            Exit Sub
        End If
        
        If lNumberOfBars = 0 Then
            lNumberOfBars = lStepCount
        End If
        lCurrentStatus = CLng((lStep / lStepCount) * lNumberOfBars)
        lPctComplete = Round(lCurrentStatus / lNumberOfBars * 100, 0)
        sLabel = lPctComplete & "% Complete"
        sBarText = sPrependedBoundaryText & String(lCurrentStatus, sBarChar) & Space$(lNumberOfBars - lCurrentStatus) & sAppendedBoundaryText
        Select Case eLabelPlacement
            Case LabelPlacement.None: sStatusBarText = sBarText
            Case LabelPlacement.Prepend: sStatusBarText = sLabel & " " & sBarText
            Case LabelPlacement.Append: sStatusBarText = sBarText & " " & sLabel
        End Select
        Application.StatusBar = sStatusBarText
        ''Debug.Print "CurStatus:"; lCurrentStatus, "PctComplete:"; lPctComplete, "'"; sStatusBarText; "'"
    End Sub
    
    ''' <summary>
    ''' Method to display a simple Excel ProgressBar made up of vertical bars | with a trailing label. Called once for each step in the calling code process.
    '''
    ''' Adapted
    ''' From: Excel VBA StatusBar
    ''' Link: https://www.wallstreetmojo.com/vba-status-bar/
    ''' </summary>
    ''' <param name="Step">The current step count.</param>
    ''' <param name="StepCount">The total number of steps.</param>
    ''' <param name="NumberOfBars">Optional, Number of bars displayed for StepCount. Defaults to StepCount. The higher the number, the longer the string.</param>
    ''' <param name="ClearStatusBar">Optional, True to clear the StatusBar. Defaults to False.</param>
    Private Sub DisplaySimpleProgressBarStep( _
        lStep As Long, _
        lStepCount As Long, _
        Optional lNumberOfBars As Long = 0, _
        Optional bClearStatusBar As Boolean = False _
        )
        Call DisplayProgressBarStep(lStep, lStepCount, lNumberOfBars, bClearStatusBar:=bClearStatusBar)
    End Sub

Answer 4

============== 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 Command Buttons and 3 Labels so you get the following objects

Element	Purpose	Properties to set
UserForm1	canvas to hold other 5 elements
CommandButton1	Close UserForm1	Caption: "Close"
CommandButton2	Run Progress Bar Code	Caption: "Run"
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

Then add this code to UserForm1:

======== 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  ' Memorize initial/maximum 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 =====================

Answer 5

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.

Answer 6

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

Answer 7

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.

Answer 8

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:

1. Use CreateWindowEx() to create the progress bar

A 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.

Answer 9

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

Answer 10

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

Answer 11

In the past, with VBA projects, I've used a label control with the background colored and adjust the size based on the progress. Some examples with similar approaches can be found in the following links:

1. http://oreilly.com/pub/h/2607
2. http://www.ehow.com/how_7764247_create-progress-bar-vba.html
3. http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

Here is one that uses Excel's Autoshapes:

http://www.andypope.info/vba/pmeter.htm

Answer 12

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

Answer 13

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

Answer 14

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.

Answer 15

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