30 Minute Countdown clock for an Excel test

[DCpics]

I have created an Excel test for our group at work, and my boss has asked me to put in a 30 minute countdown clock that will lock the spreadsheet down after 30 minutes (of if they finish early and press the Start/Stop button).

I would like the timer to be started and stopped by a Start/Stop button, but like I mentioned, if they take longer than 30 minutes it will make their spreadsheet read only.

Can you guys help with this one? Thank you very much!

Mike

 

[ExcelGuyDude]

There are a variety of ways to do what you're wanting. You should research the various methods and find what kind of countdown you want.

There are also lots of forums already available for you to grab their codes. A simple example is from this YouTube:
https://www.youtube.com/watch?v=sbJeGG_Xv8M

Please research other forums before you ask questions like this... as you might imagine, this is a question that is common and has already been answered.

 

[DCpics]

There are a variety of ways to do what you're wanting. You should research the various methods and find what kind of countdown you want.

There are also lots of forums already available for you to grab their codes. A simple example is from this YouTube:
https://www.youtube.com/watch?v=sbJeGG_Xv8M

Please research other forums before you ask questions like this... as you might imagine, this is a question that is common and has already been answered.

I've been searching this forum, and the internet for the past 3 hours and finally gave up and decided to ask my question here. I have found tons of countdown timers, but haven't found one that does exactly what I need. I'll try this Youtube link (YouTube is restricted at work, so I'll have to use my phone).

Thanks.

 

[ExcelGuyDude]

This is not an easy task to do, but it is possible... I found a code here:
Excel Countdown Timer.

It seemed to work pretty well. The only information I grabbed from it is the following:

Dim CountDown As Date
Sub Timer()
    CountDown = Now + TimeValue("00:00:01")
    Application.OnTime CountDown, "Reset"
End Sub
Sub Reset()
Dim count As Range
    Set count = [A1] ' A1 contains the time you want for the countdown.
    count.Value = count.Value - (1 / 24 / 60 / 60) ' This removes one second off the value in [A1]
    If count <= 0 Then
        [A1] = "12:30:00 AM" ' This is resetting the clock (May not be necessary)
        MsgBox "Countdown complete."
        Exit Sub
    End If
    Call Timer
End Sub
Sub DisableTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=CountDown, Procedure:="Reset", Schedule:=False
    [A1] = "12:30:00 AM"
End Sub

What I did was place in cell "A1" the value "12:30:00 AM". That will convert to 30 minutes when you change the custom format to "mm:ss".

I inserted a couple shapes into the worksheet, and assigned the "Timer" macro to the "Start" button, and the "DisableTimer" macro to the "Stop" button.
There are a couple problems with this.
1. If you hit "Start" multiple times, it will increase the timer speed one second faster.
2. When you hit "Stop", it doesn't freeze the screen or anything.

A possible solution would be to create an inputbox that requires the user to insert a password to go back to the test results. You could have the macro save the workbook immediately and close it. You could have it save the workbook and change to Read-Only.

This depends on the needs you have for this report.

Hope this gets you on track!

 

[ExcelGuyDude]

I made a change just for a more accurate timing measurement.

Dim CountDown As Date, StartTime As Date, CountTiming As Date
Sub Timer()
    If StartTime = 0 Then StartTime = Now
    If CountTiming = 0 Then CountTiming = [A1].Value
    CountDown = Now + TimeValue("00:00:01")
    Application.OnTime CountDown, "Reset"
End Sub
Sub Reset()
    On Error Resume Next
    [A1] = CountTiming - (Now - StartTime) ' This counts down from the start time
    If CountTiming - (Now - StartTime) <= 0 Then
        [A1] = CountTiming ' This is resetting the clock (May not be necessary)
        MsgBox "Countdown complete."
        CountTiming = 0
        StartTime = 0
        Exit Sub
    End If
    Call Timer
End Sub
Sub DisableTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=CountDown, Procedure:="Reset", Schedule:=False
    [A1] = CountTiming
    CountTiming = 0
    StartTime = 0
End Sub

 

[DCpics]

Thank you very much for your help! This is great. I really appreciate it.