Progress bar VBA In excel

Hi,

Have a look here:

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

Kris

it looks good but how do i use it?  i don't even see the code

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

Kris

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

Select allOpen in new window

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

Select allOpen in new window

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

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

Select allOpen in new window

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

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.

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

Select allOpen in new window

thanks

karinos57,

Please explain why you have awarded a B grade.

Thanks in advance.

Patrick