Avatar of Bright01
Bright01
Flag for United States of America asked on

Countdown Timer Advanced

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
Microsoft ExcelMicrosoft Office

Avatar of undefined
Last Comment
Professor J

8/22/2022 - Mon
byundt

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
SOLUTION
Professor J

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
ASKER CERTIFIED SOLUTION
byundt

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Bright01

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

Thank you!

B.
Professor J

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
Your help has saved me hundreds of hours of internet surfing.
fblack61