Countdown Timer Advanced

Bright01
Bright01 used Ask the Experts™
on
I have a Timer that Professor JimJam wrote from EE to help me with a project.  I need another enhancement.  Can someone take a look at how I can, on the initial WS, designate an input that would include not only seconds, but Minutes and Hours with the appropriate countdown in Minutes and or Seconds?

Thank you in advance.

B.
Countdown-Timerv2.xlsb
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
View Solutions Only
byundtMechanical Engineer
Most Valuable Expert 2013
Top Expert 2013

Commented:
Jim,
I modified the code so the cell would display the remaining time in [h]:mm:ss format, updating every second. I also played around with the text displayed on the button--which is now a Forms button rather than the ActiveX button that morphed its shape on me when I clicked it.

Brad

Sub cmdStop_Click()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp.TextFrame.Characters
    If .Text = "Timer: Off" Then
        Call Stopper
        .Text = "Timer: Resume"
    
    ElseIf .Text = "Timer: Resume" Then
        .Text = "Timer: Off"
        Call Starter(True)
    
    ElseIf .Text = "Timer: Start" Then
        .Text = "Timer: Off"
        Call Starter(False)
    
    Else
        .Text = "Timer: Off"
        Call Starter(False)
        ActiveSheet.Range("A2").Select
    End If
End With
End Sub

Sub Starter(bResume As Boolean)
    Status = True
    Dim WarningTime As Integer
    Dim Period As Double
    Dim MyTime As Double
    Dim Countdown As Double
    
    With Sheets("Main")
        If (.Cells(5, 1) = "") Then
            WarningTime = .Cells(5, 4)
        Else
            WarningTime = .Cells(5, 1)
        End If
        
        If (.Cells(8, 1) = "") Then
            Period = .Cells(8, 4)
        Else
            Period = .Cells(8, 1)
        End If
    End With
    
    If (Period < 0.01) Then Period = 0.01
    
    Sheets("Counter").Select
    With Sheets("Counter").Cells(2, 1)
        .Select
        .FormatConditions.Delete
        .FormatConditions.Add xlCellValue, xlLessEqual, WarningTime
        With .FormatConditions(1).Font
            .Bold = True
            .ColorIndex = 3
        End With
        
        '.NumberFormat = Choose(Log(Period) / Log(10) + 3, "0.00", "0.0", "0")
        .NumberFormat = "[h]:mm:ss"
    
        If bResume = False Then .Value = (Sheets("Main").Cells(2, 1).Value + Period) / 86400
        Countdown = .Value * 86400
        While (Countdown > Period And Status)
            Countdown = Countdown - Period 'Time remaining in seconds
            .Value = Countdown / 86400
            MyTime = Countdown
            For i = 1 To 100 * Period
                Sleep 10
                MyTime = MyTime - 0.01
                If (MyTime <= 0) Then Exit For
                DoEvents
            Next i
        Wend
        If (Countdown <= Period) Then
            .Value = "Time Up!"
            ActiveSheet.Shapes("Button 3").TextFrame.Characters.Text = "Timer: Start"
        End If
    End With
End Sub

Open in new window

Countdown-Timerv2.xlsb
Professor JMicrosoft Excel Expert
Top Expert 2014
Commented:
thanks byundt.  you definitely made this much better.

for the finishing touches, i have made a small modification in Mainsheet uploaded two versions as final

V3  added in Main Sheet C1 E1 D1 to be filled numeric hours minutes seconds cells highlighted yellow .

V4 added in Main Sheet C1 only to be put time as the Excel timer format cell highlighted yellow.
Countdown-Timerv3.xlsb
Countdown-Timerv4.xlsb
Mechanical Engineer
Most Valuable Expert 2013
Top Expert 2013
Commented:
I noticed that the Conditional Formatting for the Warning wasn't happening in ProfessorJimJam's V4 workbook, so I modified the bits involving WarningTime to remedy that situation. This involved changing the variable to a Double, dividing the value from the worksheet by 86400 (number of seconds in a day), and referencing column C rather than D to get its value.

FWIW, the V3 workbook needed the exact same changes to the code. Just use the Starter sub as shown below in both workbooks.
Sub Starter(bResume As Boolean)
    Status = True
    Dim WarningTime As Double
    Dim Period As Double
    Dim MyTime As Double
    Dim Countdown As Double
    
    With Sheets("Main")
        If (.Cells(5, 1) = "") Then
            WarningTime = .Cells(5, 3) / 86400
        Else
            WarningTime = .Cells(5, 1) / 86400
        End If
        
        If (.Cells(8, 1) = "") Then
            Period = .Cells(8, 4)
        Else
            Period = .Cells(8, 1)
        End If
    End With
    
    If (Period < 0.01) Then Period = 0.01
    
    Sheets("Counter").Select
    With Sheets("Counter").Cells(2, 1)
        .Select
        .FormatConditions.Delete
        .FormatConditions.Add xlCellValue, xlLessEqual, WarningTime
        With .FormatConditions(1).Font
            .Bold = True
            .ColorIndex = 3
        End With
        
        '.NumberFormat = Choose(Log(Period) / Log(10) + 3, "0.00", "0.0", "0")
        .NumberFormat = "[h]:mm:ss"
    
        If bResume = False Then .Value = (Sheets("Main").Cells(2, 1).Value + Period) / 86400
        Countdown = .Value * 86400
        While (Countdown > Period And Status)
            Countdown = Countdown - Period 'Time remaining in seconds
            .Value = Countdown / 86400
            MyTime = Countdown
            For i = 1 To 100 * Period
                Sleep 10
                MyTime = MyTime - 0.01
                If (MyTime <= 0) Then Exit For
                DoEvents
            Next i
        Wend
        If (Countdown <= Period) Then
            .Value = "Time Up!"
            ActiveSheet.Shapes("Button 3").TextFrame.Characters.Text = "Timer: Start"
        End If
    End With
End Sub

Open in new window

Countdown-Timerv4.xlsb
Bright01

Author

Commented:
Great job guys!  This is workable. Great Teamwork from both of you in getting this just right.

Thank you!

B.
Professor JMicrosoft Excel Expert
Top Expert 2014

Commented:
you are welcome Bright01.

byundt,  hit the nail on the head.

i just did one last small change to the last code posted by byundt

changing the line on sub routine Starter from 
ActiveSheet.Shapes("Button 3").TextFrame.Characters.Text = "Timer: Start"

Open in new window

To
        ThisWorkbook.Sheets("Counter").Shapes("Button 3").TextFrame.Characters.Text = "Timer: Start"
        ThisWorkbook.Activate

Open in new window


if the Counter worksheet wasn't active sheet while the timer is ended, it would have thrown an error. so now, even if you working in another workbook or in another sheet, when the timer ends, it will not give error.

i have uploaded both versions. v4 and v3.
Best-Countdown-Timer-V4.xlsb
Best-Countdown-Timer-V3.xlsb

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial