?
Solved

Progress bar VBA In excel

Posted on 2009-12-23
13
Medium Priority
?
815 Views
Last Modified: 2013-11-25
I can't seem to find any info in Excel about creating a progress bar when my macro executes. Can someone help me here?  I am using office 2007.

Thanks,
0
Comment
Question by:karinos57
  • 5
  • 5
  • 3
13 Comments
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 26114195
Hi,

Have a look here:

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

Kris
0
 

Author Comment

by:karinos57
ID: 26114426
it looks good but how do i use it?  i don't even see the code
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 26114519

Download the workbook. I think the workbook has all the info you want.

Kris
0
Get your Disaster Recovery as a Service basics

Disaster Recovery as a Service is one go-to solution that revolutionizes DR planning. Implementing DRaaS could be an efficient process, easily accessible to non-DR experts. Learn about monitoring, testing, executing failovers and failbacks to ensure a "healthy" DR environment.

 

Author Comment

by:karinos57
ID: 26114585
Hey Kris,
i found this code but the only problem i have is how to create the shape.  Can you please help me at least with the shape that i have create in the workbook.  It will be great if you can put it in excel the code and the shape so i can see some kind of sample.  thanks.
Sub RefreshExternalData()
    Range("A6").Select
    Selection.QueryTable.Refresh BackgroundQuery:=False
End Sub

Public Sub WaitingShape(Msg As String)
'
' Macro created by Patrick Matthews
' Procedure creates a formatted shape that tells the user that a macro is working.
' Otherwise, the user may wonder why the screen has seemingly frozen!

' The shape will be deleted once the control macro is ready to resume screen updating.
    
' Msg argument is used to pass a custom message displayed in the shape

' Create a shape with the settings below.
    
    ActiveWindow.LargeScroll Up:=100, ToLeft:=100
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 83.25, 91.5, 267.75, 207.75).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .Solid
        .ForeColor.SchemeColor = 13
        .Transparency = 0#
    End With
    With Selection.ShapeRange.Line
        .Weight = 7#
        .DashStyle = msoLineSolid
        .Style = msoLineThickBetweenThin
        .Transparency = 0#
        .Visible = msoTrue
        .ForeColor.SchemeColor = 64
        .BackColor.RGB = RGB(255, 255, 255)
    End With
    Selection.Characters.Text = Msg
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Italic"
        .Size = 20
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = xlHorizontal
        .AutoSize = False
    End With
    
' Turn off screen updating to enhance performance
    
    Application.ScreenUpdating = False

' Even though the shape is deleted, it will still appear on the screen until the control
' macro resumes screen updating.

    Selection.Delete
    
End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 26116966
Hi,

You don't need to create teh shape. The code itself creates it.

Try


Kris
Sub RefreshExternalData()
    Range("A6").Select
    WaitingShape "Data is updating....."
    Selection.QueryTable.Refresh BackgroundQuery:=False
    Application.ScreenUpdating = True
End Sub
Public Sub WaitingShape(Msg As String)
'
' Macro created by Patrick Matthews
' Procedure creates a formatted shape that tells the user that a macro is working.
' Otherwise, the user may wonder why the screen has seemingly frozen!

' The shape will be deleted once the control macro is ready to resume screen updating.
    
' Msg argument is used to pass a custom message displayed in the shape

' Create a shape with the settings below.
    
    ActiveWindow.LargeScroll Up:=100, ToLeft:=100
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 83.25, 91.5, 267.75, 207.75).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .Solid
        .ForeColor.SchemeColor = 13
        .Transparency = 0#
    End With
    With Selection.ShapeRange.Line
        .Weight = 7#
        .DashStyle = msoLineSolid
        .Style = msoLineThickBetweenThin
        .Transparency = 0#
        .Visible = msoTrue
        .ForeColor.SchemeColor = 64
        .BackColor.RGB = RGB(255, 255, 255)
    End With
    Selection.Characters.Text = Msg
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Italic"
        .Size = 20
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = xlHorizontal
        .AutoSize = False
    End With
    
' Turn off screen updating to enhance performance
    
    Application.ScreenUpdating = False

' Even though the shape is deleted, it will still appear on the screen until the control
' macro resumes screen updating.

    Selection.Delete
    
End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:patrickab
ID: 26119879
karinos57,

A progress bar is not a good idea as it slows down your main macro. It is far better to use the StatusBar and to include in your macro simple lines of code like this:

within the loop...
Application.StatusBar = True
Application.StatusBar = some sort of counter value here

and after the loop to reset the StatusBar...
Application.StatusBar = False

The StatusBar is visible at the bottom left of the screen.

Patrick
0
 

Author Comment

by:karinos57
ID: 26120446
patrickab,
i really need something that is very simple like the way you described here but i am having some issues.  Below is the code i am using but not sure where to put your code or modify mine.  Pls. help
thanks
Sub AskUserToParent()
Dim Answer As String
Dim MyMessage As String
Application.ScreenUpdating = False

    MyMessage = "Hello" & " " & Application.UserName & "," & " Please note that you have to be connected to Premier Network in order this update to occur.  Click Yes to continue otherwise click No to cancel the update ."
    Answer = MsgBox(MyMessage, vbQuestion + vbYesNo)
    
    If Answer = vbYes Then
    MsgBox ("Depending upon your network connection, this update can take up to three (3) minutes.")

    
    Application.ScreenUpdating = False
    Call refresh_data
    Application.ScreenUpdating = False
    Application.OnTime Now + TimeValue("00:00:4"), "Macro2"
    Application.ScreenUpdating = False
    Sheets("Original").PivotTables("PivotTable1").PivotCache.Refresh
    
    Else
    Exit Sub
        
    End If
End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:patrickab
ID: 26120472
karinos57,

May I ask what you are expecting a StatusBar or progress bar to do in these circumstances. There doesn't appear to be a loop to measure and report its progress.

Patrick
0
 

Author Comment

by:karinos57
ID: 26120539
I've got an Excel spreadsheet that pulls data from sql server.  When user select top parent - the value in cell A1 is changed too as a result the external data is automatically refreshed.

Issue: the user has no indication that the program is doing anything.  Sometimes the query completes quickly in 20 seconds.  But sometimes it may take upwards of 2 minutes depending the size of the data, during which time the user has no clue that anything is being updated.  I'd like a progress bar or any thing that lets the user know that the data is being refreshed and they need to wait.
0
 
LVL 45

Expert Comment

by:patrickab
ID: 26120640
karinos57,

>I'd like a progress bar or any thing that lets the user know that the data is being refreshed and they need to wait.

I understand. Suggested code below.

Patrick
Sub AskUserToParent()
Dim Answer As String
Dim MyMessage As String
Application.ScreenUpdating = False
 
    MyMessage = "Hello" & " " & Application.UserName & "," & " Please note that you have to be connected to Premier Network in order this update to occur.  Click Yes to continue otherwise click No to cancel the update ."
    Answer = MsgBox(MyMessage, vbQuestion + vbYesNo)
    
    Application.StatusBar = True
    Application.StatusBar = "Please be patient - extracting data over the Network"
     
    If Answer = vbYes Then
    MsgBox ("Depending upon your network connection, this update can take up to three (3) minutes.")
 
     
    Application.ScreenUpdating = False
    Call refresh_data
    Application.ScreenUpdating = False
    Application.OnTime Now + TimeValue("00:00:4"), "Macro2"
    Application.ScreenUpdating = False
    Sheets("Original").PivotTables("PivotTable1").PivotCache.Refresh
     
    Else
    Exit Sub
         
    End If
    Application.StatusBar = "All done - thanks for your patience"
    Application.Wait (Now + TimeValue("0:00:05"))
    Application.StatusBar = False
End Sub

Open in new window

0
 
LVL 45

Accepted Solution

by:
patrickab earned 1500 total points
ID: 26121013
ps. The StatusBar message "Please be patient - extracting data over the Network" will be visible whilst the macro is running.
0
 

Author Closing Comment

by:karinos57
ID: 31669504
thanks
0
 
LVL 45

Expert Comment

by:patrickab
ID: 26171656
karinos57,

Please explain why you have awarded a B grade.

Thanks in advance.

Patrick
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

862 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question