Countdown Timer

melbridge

New Member
Joined
Jan 22, 2009
Messages
9
Hi,
I've made a workbook for my son to practice his times tables.
It has 2 buttons:
'Start' unlocks the sheet, generates random numbers for the sums and does some formatting then relocks the sheet.
'Stop' unlocks the sheet, checks the answers and relocks the sheet.

I would like to add a countdown timer which gets the time (in seconds) from cell C1 and then counts down this time in cell F1

When the stop button is clicked I would like it to stop the timer and run the 'checking' code or if the timer reaches 0 I would like it to run the checking code.

I have tried lots of different code to do this (I've spent the last 3 nights pulling what's left of my hair out trying to get it to work!) but without success. The closest I got was some code which would do the timer but as soon as you clicked into a cell the countdown stopped.

I know similar questions have been asked, but I just can't get it to work!
My VBA coding doesn't go beyond recording macros or copying code then (trying to) modify it to make to work - beginner +1

Please help! The file is in my dropbox here:
http://db.tt/Z1lbI8N

Thanks, Melbridge.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Unlock cell F1 so the Timer can update it without the need to unprotect the sheet each time the countdown updates.

In the "Main" worksheet module
Code:
Private Sub cmdStart_Click()

   Call Reset

   Range("F1").Value = Range("C1").Value
   Call TimerRun

End Sub

Private Sub cmdStop_Click()

   Call TimerStop
   Call Check

End Sub

In any standard module e.g. Module4
Code:
Private NextTime As Date

Sub TimerRun()

    If IsNumeric(Range("F1")) And Range("F1") > 0 Then
            ' Minimum time interval = 1 second
            NextTime = Now + TimeValue("00:00:01")
            Application.OnTime NextTime, "TimerCountDown"
    Else
        MsgBox "Invalid ""Time Allowed"" value.", vbCritical, "Can't Start Timer Countdown"
    End If

End Sub

Sub TimerCountDown()

    Range("F1").Value = Range("F1").Value - 1
    If Range("F1").Value > 0 Then
        Call TimerRun
    Else
        Call Check
    End If

End Sub

Sub TimerStop()

    On Error Resume Next
    Application.OnTime EarliestTime:=NextTime, Procedure:="TimerCountDown", Schedule:=False

End Sub


TIP: If you want to eliminate the screen from flickering when run the Reset or Check macros, put the as the beginning of each macro...
Application.ScreenUpdating = False

...and this at the end of each.
Application.ScreenUpdating = True
 
Upvote 0
Thank you very much AlphaFrog,
This works perfectly!
I'll have to read through it in a bit more detail when I get a few minutes to learn how it works and what I was doing wrong!
 
Upvote 0

Forum statistics

Threads
1,215,219
Messages
6,123,684
Members
449,116
Latest member
HypnoFant

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