Countdown Timer Advanced

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

Select allOpen in new window

Countdown-Timerv2.xlsb

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

Thank you!

B.

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"

Select allOpen in new window

To

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

Select allOpen 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