Progress bar in VBA Excel

from:http://stackoverflow.com/questions/5181164/progress-bar-in-vba-excel

I'm doing a 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 cant make it.

EDIT: My problem is with the progressbar control, I cant see the bar 'progress', it just complete when the form pops up. I use a loop and DoEvent but that isn't working. Plus, I want the process to repeat, not just one time.

excel vba excel-vba

shareimprove this question

edited Mar 28 '14 at 19:20

eykanal
9,86574575

asked Mar 3 '11 at 13:14

darkjh
97851832

 

 

"tried for some time but can't make it" - show us what you've managed to do, what are the problems and we'll try to help you –  Grzegorz Oledzki Mar 3 '11 at 13:18

 

thx for advice, see edit –  darkjh Mar 3 '11 at 13:49

add a comment

9 Answers

activeoldestvotes

up vote15down voteaccepted

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

---

I used a progress bar example on userform.Therewithal you can do filtering via this UserForm. When you press the filter button ,opens progress bar.An advanced progress bar instance. 

Template Downloading Link :https://netmerkez.wordpress.com/2015/06/26/filtering-via-userform/

shareimprove this answer

edited Jun 26 at 10:53

kadrleyn
73

answered Mar 3 '11 at 13:30

Matt
7,8332951

 

 

thx i will try this way –  darkjh Mar 3 '11 at 13:49

 

@darkjh: You're welcome. Seeing you're new, please remember to accept and/or up vote if this answers your question or is helpful. Thanks. –  Matt Mar 3 '11 at 14:02 

add a comment

up vote48down vote

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

shareimprove this answer

answered Oct 16 '12 at 15:22

eykanal
9,86574575

 

3 

Glad I saw this. Was a much better idea for me than actually faking a progress bar. –  atomicules Mar 19 '13 at 16:22

1 

As am I - simple and effective. –  Sean Dec 2 '13 at 11:58

 

Fantastic answer. +1 –  Caltor Mar 3 at 16:37

add a comment

up vote20down vote

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 - ProgressBarOption ExplicitPrivate statusBarState As BooleanPrivate enableEventsState As BooleanPrivate screenUpdatingState As BooleanPrivate Const NUM_BARS As Integer = 50Private Const MAX_LENGTH As Integer = 255Private BAR_CHAR As StringPrivate SPACE_CHAR As StringPrivate 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 = FalseEnd SubPrivate Sub Class_Terminate()    ' Restore settings    Application.DisplayStatusBar = statusBarState    Application.ScreenUpdating = screenUpdatingState    Application.EnableEvents = enableEventsState    Application.StatusBar = FalseEnd SubPublic 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 = displayEnd Sub

Sample Usage:

Dim progressBar As New ProgressBarFor i = 1 To 100    Call progressBar.Update(i, 100, "My Message Here", True)    Application.Wait (Now + TimeValue("0:00:01"))Next

shareimprove this answer

edited Oct 6 '14 at 15:43

cptully
133

answered Sep 7 '13 at 1:38

Zack Graber
37626

 

add a comment

up vote6down vote

============== This code goes in Module1 ============Sub ShowProgress()    UserForm1.ShowEnd 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 elementsCommandButton2 = Run Progress Bar Code; Caption:RunCommandButton1 = Close UserForm1; Caption:CloseBar1 (label) = Progress bar graphic; BackColor:BlueBarBox (label) = Empty box to frame Progress Bar; BackColor:WhiteCounter (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 completePrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Sub UserForm_Initialize()    Bar1.Tag = Bar1.Width    Bar1.Width = 0End SubSub 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    NextEnd SubPrivate Sub CommandButton1_Click() 'CLOSE buttonUnload MeEnd SubPrivate Sub CommandButton2_Click() 'RUN button        ProgressBarDemoEnd Sub================= UserForm1 Code Block End =================================== This code goes in Module1 =============Sub ShowProgress()    UserForm1.ShowEnd Sub============== Module1 Code Block End =============

shareimprove this answer

answered Jul 12 '12 at 6:33

John Harris
6111

 

 

This is a nice solution! –  Stephan Dec 6 '12 at 14:10

add a comment

up vote4down vote

The label control that resizes is a quick solution. However, most people end up creating individual forms for each of their macros. I used 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.

shareimprove this answer

answered Apr 30 '14 at 20:17

Ejaz Ahmed
514

 

 

I also found the "Abort" Button on the Dialog very helpful, thank you. –  Thomas Stracke Aug 12 '14 at 8:21

1 

Hi Thomas. We all want to stop a loop at will, that is why I coded that in. Thanks for noticing. Have a great day. –  Ejaz Ahmed Aug 15 '14 at 20:43

add a comment

up vote0down vote

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 processingNext intRow

Minimal code, looks decent.

shareimprove this answer

answered Jul 5 '14 at 15:32

Lucretius
2681620

 

2 

Main issue I see with this approach is that I often turn off screen updates and calcs when I am doing large operations that make a progress bar useful. –  VoteCoffee Jul 17 '14 at 21:05

add a comment

up vote0down vote

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

shareimprove this answer

edited Jul 3 at 11:27

randomsimon
734

answered Feb 10 '14 at 18:22

user3294122
19

 

 

What is your question? –  Koitoer Feb 10 '14 at 18:40

add a comment

up vote0down vote

Hi modified version of another post by Marecki. Has 4 styles

1. dots ....2  10 to 1 count down3. 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 'ShowProgressSub 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 IfEnd Sub

shareimprove this answer

answered Aug 5 at 0:01

ozmike
9221121

 

add a comment

up vote-1down vote

Nice dialog progressbar form i looked for. progressbar from alainbryden

very simple to use, and looks nice. Just to info.

edit: only for premium members now :/

here is nice alternative class.

shareimprove this answer

edited Apr 17 at 16:50

answered Apr 8 '14 at 2