Usng Progress bars to track a project

rob737

Board Regular
Joined
May 12, 2015
Messages
129
Good morning forum

I would like some assistance with a project I am planning using progress bars, background as follows:

Currently using excel 2010:

Windows 7:

Programming Standard: Novice.

Project: I would like to use a number of progress bars to track steps in a project. Each step takes a different time to complete, however I would like to be able to click a user control if the task has completed before time.

I appreciate this is not a trivial task, however I would appreciate a starting point. I want to display the current time as the start point and update the time display and progress bars every 30 seconds. So I think it looks something like this

Display Current time: 12:18 ' Display currnt time and update every 30 seconds

Progress Bar TaskA (5minutes) ----> Progress Bar TaskB (3 minutes)


When TaskA completes (or the control is selected) TaskB starts. If TaskA does not complete in 5 minutes the progress bar turns red and TaskB does not start until the user control on Task A is selected.


I can do all the userforms stuff myself I just need a hand with is using the system time to driving and updated a progress bar and as each progress bar completes the next one starts.

Hope you can give me a starting point or request more detail on what I am trying to achieve.

Many thanks
Best regards
Rob
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hi,

I am not entirely sure what you mean by Progress Bars but this was my idea :)

Have one bar per row.
Have one time interval per column.
Mark the individual bars with a "#" symbol.
Put the control in column A.
Put the start time in column B.
Put the elapsed time in column C.
Insert the bars (hash/pound/gate) symbols from column D onwards.

There is a macro to get everything started but it is a "fire and forget" system. It just starts another macro then stops.
The second macro does most of the work - and this is where it gets complicated.

The basic idea is to use Application.OnTime to re-submit itself after each time interval has elapsed.
It needs to know whether it is the first run through for a row and that is what the flgStart variable does.
It initialises all the times (start, finish, elapsed).
It looks for symbols in the row to see where the bar is.
It uses that information to calculate the times.


If the bar is within the time limit it changes its colour.
If it is over the limit it changes the whole bar to red.
It re-submits itself.
If an "X" has been set in column A it terminates the current bar and moves to the next row.

Code:
Dim flgStart As Boolean
Dim iRow As Long

Sub Progress()
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ws
        .Range("A1:C99").ClearContents
        .Range("A1:C1") = Array("Stop", "Start Time", "Elapsed Time")
        .Range("D1:X99").ClearFormats
    End With
    flgStart = False
    iRow = 3
    Call FillCell
End Sub

Sub FillCell()

    Const tInterval As Long = 2 ' seconds
    
    Static r As Range
    Static tStart As Date
    Static tFinish As Date
    Static tElapsed As Date
    Static fc As Long
    Static lc As Long

    With ws
    
        If flgStart = False Then
            fc = .Cells(iRow, 3).End(xlToRight).Column
            If fc = .Columns.Count Then
                MsgBox "Completed"
                Exit Sub
            End If
            lc = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
            tStart = Now
            .Cells(iRow, 2).Value = tStart
            tFinish = (lc - fc + 1) * tInterval
            tElapsed = 0
            flgStart = True
            Set r = .Cells(iRow, fc)
        Else
            tElapsed = tElapsed + TimeSerial(0, 0, tInterval)
        End If
        
        .Cells(iRow, 3).Value = tElapsed
        
        If r.Value = "#" And Now < (tStart + TimeSerial(0, 0, tFinish)) Then
            r.Interior.ColorIndex = 7
            Set r = r.Offset(0, 1)
        End If
        
        If Now >= (tStart + TimeSerial(0, 0, tFinish)) Then
            .Range(.Cells(iRow, fc), .Cells(iRow, lc)).Interior.ColorIndex = 3
        End If
        
        If flgStart Then
            NextTime = Now + TimeSerial(0, 0, tInterval)
            Application.OnTime NextTime, "FillCell", , True
        End If
        
        If .Cells(iRow, "A").Value = "x" Then
            iRow = iRow + 1
            flgStart = False
        End If
        
    End With

End Sub


Excel 2013
ABCDEFGHIJKLMNOPQRSTUVWX
1StopStart TimeElapsed Time
2
3x20:10:5900:00:04##########
4x20:11:0600:00:16######
5x20:11:2400:00:08#####
Sheet1
 
Upvote 0
Thank you for that "My Answer Is This".

I was not entirely sure what the OP was wanting so I started with a cheap, cheerful but moderately pretty solution. :)

Regards,
 
Upvote 0
Hi RickXL
Many thanks for your help with this, unfortunately I am having a bit of trouble getting it to run. Please keep in mind I am a beginner.
I followed these steps:

  1. Opened a new spreadsheet
  2. Developer – view code
  3. Insert - module
  4. Cut and paste your code into the code window of the module
  5. Run code
  6. Run-Time error ‘424’: object required
  7. Reset
  8. Cursor at Sub Progress() ‘ pressed F8
  9. Fails at line fc = .Cells(iRow, 3).End(xlToRight).Column
  10. Turned on watch window
  11. Can’t see at this stage what is wrong.
  12. If I select ‘macros’ from the developer tool bar I get FillCell and Progres
I will continue to try to find the problem.
Once again many thanks for your time with this,
Best Regards
Rob
 
Upvote 0
Hi,

Apologies, I am the beginner here. I can't work copy and paste!

Try it with the first line included :oops:

By the way, you will need to put some # symbols in row 3 starting after column 3 and columns B and C will need formatting as times.
If you want a pushbutton, say, to stop the timer just make it place an "x" in column A.

Code:
Dim ws As Worksheet
Dim flgStart As Boolean
Dim iRow As Long

Sub Progress()
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ws
        .Range("A1:C99").ClearContents
        .Range("A1:C1") = Array("Stop", "Start Time", "Elapsed Time")
        .Range("D1:X99").ClearFormats
    End With
    flgStart = False
    iRow = 3
    Call FillCell
End Sub

Sub FillCell()

    Const tInterval As Long = 2 ' seconds
    
    Static r As Range
    Static tStart As Date
    Static tFinish As Date
    Static tElapsed As Date
    Static fc As Long
    Static lc As Long

    With ws
    
        If flgStart = False Then
            fc = .Cells(iRow, 3).End(xlToRight).Column
            If fc = .Columns.Count Then
                MsgBox "Completed"
                Exit Sub
            End If
            lc = .Cells(iRow, .Columns.Count).End(xlToLeft).Column
            tStart = Now
            .Cells(iRow, 2).Value = tStart
            tFinish = (lc - fc + 1) * tInterval
            tElapsed = 0
            flgStart = True
            Set r = .Cells(iRow, fc)
        Else
            tElapsed = tElapsed + TimeSerial(0, 0, tInterval)
        End If
        
        .Cells(iRow, 3).Value = tElapsed
        
        If r.Value = "#" And Now < (tStart + TimeSerial(0, 0, tFinish)) Then
            r.Interior.ColorIndex = 7
            Set r = r.Offset(0, 1)
        End If
        
        If Now >= (tStart + TimeSerial(0, 0, tFinish)) Then
            .Range(.Cells(iRow, fc), .Cells(iRow, lc)).Interior.ColorIndex = 3
        End If
        
        If flgStart Then
            NextTime = Now + TimeSerial(0, 0, tInterval)
            Application.OnTime NextTime, "FillCell", , True
        End If
        
        If .Cells(iRow, "A").Value = "x" Then
            iRow = iRow + 1
            flgStart = False
        End If
        
    End With

End Sub
 
Upvote 0
I think you should change the line to look like this
Code:
fc = Cells(iRow, 3).End(xlToRight).Column
Code:
Hi RickXL
Many thanks for your help with this, unfortunately I am having a bit of trouble getting it to run. Please keep in mind I am a beginner.
I followed these steps:

  1. Opened a new spreadsheet
  2. Developer – view code
  3. Insert - module
  4. Cut and paste your code into the code window of the module
  5. Run code
  6. Run-Time error ‘424’: object required
  7. Reset
  8. Cursor at Sub Progress() ‘ pressed F8
  9. Fails at line fc = .Cells(iRow, 3).End(xlToRight).Column
  10. Turned on watch window
  11. Can’t see at this stage what is wrong.
  12. If I select ‘macros’ from the developer tool bar I get FillCell and Progres
I will continue to try to find the problem.
Once again many thanks for your time with this,
Best Regards
Rob
 
Upvote 0
"My Answer Is This",

That might work. but it will assume that the active worksheet is the one to be processed. Which may well be right most times.

If you leave in the dots and add the missing line from the top of the macro that will make the worksheet object available in all places. The value of ws is set in the first macro. I prefer to tie down exactly which workbook and worksheet is supposed to be used then it does not matter how many workbooks are opened or which sheet you look at as the macro is running. If you rely on Cells without the dot, if you open a new workbook while the macro is running it might start processing the data in the new workbook instead.

You can use Cells without the dot inside a worksheet events macro because that will know which sheet is concerned.

Using .Cells is part of the "With ws" construct.
Code:
With ws
    .Cells(1,2).Value=99
End With
Means:
Code:
ws.Cells(1,2).Value=99

I hope this helps,
 
Upvote 0
Hi Rick

Once again thanks for all your help with this, unfortunately I am still having a bit of a problem. I have completed as follows.


  1. Opened a new workbook and copied the code into a new Module
  2. Selected columns B and C and formatted them as time
  3. Added the ‘#’ symbol into D3 E# F3 and G3
  4. Executed macro and get Run-time error 91 Object Variable or With Block variable not set
  5. Selected debug
  6. Goes to line fc = .Cells(iRow, 3).End(xlToRight).Column
  7. Reset
  8. Removed the . from Cells fc = Cells(iRow, 3).End(xlToRight).Column
  9. Executed macro Run-Time error 1004 Application defined or object defined error.
  10. Select Debug
  11. Goes to line fc = Cells(iRow, 3).End(xlToRight).Column
  12. Reset and added the . back
  13. Selected Sub Progress()
  14. Pressed F8
  15. Checked Worksheet only the # symbols I added
  16. Stepped through the code 3 times
  17. Checked the worksheet
  18. Start Time = 11:12:40 AM
  19. Elapsed time = 12:00:00 AM
  20. Cell D3 = Purple
  21. Stepped the code about three more times
  22. Start time = 11:15:10 AM
  23. Elapsed time = 12:00:00 AM
  24. Cells D3 E3 F3 and G3 all red
  25. Stepped the code once
  26. Inserted an ‘X’ in A3
  27. Start time = 11:17:07
  28. Elapsed time = 12:00:00 AM
  29. Cell D3 = Purple



I will continue to try to work it out however would appreciate any suggestions you may have

Once again

Many Thanks
Best Regards
Rob
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,020
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top