Progress bar in VBA Excel

Question

I am making an application for Excel that requires a lot of updating data from the database, so it takes time. I want to make an indicator in the form of a user, and it appears when updating data. The strip I want is just a small blue strip that moves left and right and repeats until the update is completed, without interest. I know that I should use progressbar control, but I tried for a while, but I can not do it.

EDIT : My problem with progressbar control is the bar, I do not see the progress panel. It just ends when the form pops up. I use a loop and DoEvent but this does not work. In addition, I want the process to be restarted, and not just once.

Answer 1

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

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

Here is an example that uses Excel Autoshapes:

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

Answer 2

Sometimes a simple message in the status bar is enough:

It 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 3

Here is another example of using the StatusBar as a progress bar.

Using some Unicode characters, you can simulate a progress bar. 9608 - 9615 are the codes I tried for bars. Just choose one of them depending on how much space you want to show between the bars. You can set the length of the strip by changing NUM_BARS. In addition, using the class, you can configure it to automatically initialize and release the StatusBar. As soon as the object goes out of scope, it will automatically clear 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 

Usage example:

 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 4

 ============== This code goes in Module1 ============ Sub ShowProgress() UserForm1.Show End Sub ============== Module1 Code Block End ============= 

Create a button on the sheet; map to the macro "ShowProgress"

Create a UserForm1 with two buttons, a progress bar, a panel, a 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 ============= 

Answer 5

A control that resizes is a quick fix. However, most people create individual forms for each of their macros. I used the DoEvents function and the modeless form to use one form for all your macros.

Here is the 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 module into your projects and call the progress bar: Call modProgress.ShowProgress (ActionIndex, TotalActions, Title .....)

Hope this helps.

Answer 6

I love all the solutions posted here, but I solved it using conditional formatting as a percentage-based data panel.

This applies to a number of cells, as shown below. Cells that contain 0% and 100% are usually hidden because they are just there to give a context called "LeftProgress" (on the left).

In code, I go through a table doing some things.

 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, it looks decent.

Answer 7

 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 8

Hi, a modified version of another post from Marecki . Has 4 styles

 1. dots .... 2 10 to 1 count down 3. progress bar (default) 4. just percentage. 

Before you ask why I did not edit this post, I did it, and he was refused to answer 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 9

About the progressbar control in the user form, it will not show any progress unless you use the repaint event. You should encode this event inside the loop (and obviously increase the value of the progressbar ).

Usage example:

 userFormName.repaint 

Answer 10

There were many other great posts, however I would like to say that theoretically you should be able to create a REAL progress indicator:

1. Use CreateWindowEx() to create a progress bar.

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 Must be set to the parent window. You can use the status bar or a custom form for this! Here is the Excel window structure found from Spy ++:

Therefore, it should be relatively simple using the FindWindowEx() function.

 hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar") 

After the progress bar has been created, you should 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 may look a little more “official” than the other methods outlined here.

Answer 11

Just adding my part to the above collection.

If you lack code and possibly a cool interface. Check out my GitHub for Progressbar for VBA

customizable:

Dll is for MS-Access, but should work on all VBA platforms with minor changes. There is also an Excel file with samples. You can expand vba packers to suit your needs.

This project is under development and not all errors are covered. So wait!

You need to worry about third-party dll files, and if so, please feel free to use any reliable online antivirus before deploying the dll.

Answer 12

I liked the status bar from this page:

https://wellsr.com/vba/2017/excel/vba-application-statusbar-to-mark-progress/

I updated it so that it can be used as a called procedure. No credit for 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 

Answer 13

Good progress progress bar I was looking for. progressbar from alainbryden

Very easy to use and looks good.

link: link only works for premium members: /

here is a good alternative class.

Answer 14

The solution posted by @eykanal might not be the best if you have a huge amount of data to process, since including a status bar will slow down code execution.

The following link explains a good way to create a progress bar. Works well with large amounts of data (~ 250K + records):

http://www.excel-easy.com/vba/examples/progress-indicator.html