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.

share improve this question
 
 
"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

9 Answers

up vote 15 down vote accepted

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. enter image description here

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

share improve this answer
 
 
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 

Sometimes a simple message in the status bar is enough:

Message in Excel status bar using VBA

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
share improve this answer
 
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

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
share improve this answer
 
============== 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 =============
share improve this answer
 
 
This is a nice solution! –   Stephan  Dec 6 '12 at 14:10

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.

share improve this answer
 
 
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

I'm loving all the solutions posted here, but I solved this using Conditional Formatting as a percentage-based Data Bar.

Conditional Formatting

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.

Scan progress

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.

share improve this answer
 
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
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
share improve this answer
 
 
What is your question? –   Koitoer  Feb 10 '14 at 18:40

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
share improve this answer
 

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.

share improve this answer
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值