stop this countdown timer macro

**jacksten** · 05-16-2012, 02:57 AM

Sub Countup()
Dim CountDown As Date
CountDown = Now + TimeValue("00:00:01")
Application.OnTime CountDown, "RealCount"
End Sub
Sub Realcount()
Dim count As Range
Set count = [E1]
count.Value = count.Value - TimeSerial(0, 0, 1)
If count <= 0 Then
MsgBox "SORRY - TIME UP!"
Exit Sub
End If
Call Countup
End Sub

**Bob Phillips** · 05-16-2012, 04:06 AM

Dim CountDown As Date

Sub CountUp()
    CountDown = Now + TimeValue("00:00:01")
    Application.OnTime CountDown, "RealCount"
End Sub

Sub RealCount()
Dim count As Range
    Set count = [E1]
    count.Value = count.Value - TimeSerial(0, 0, 1)
    If count <= 0 Then
        MsgBox "SORRY - TIME UP!"
        Exit Sub
    End If
    Call CountUp
End Sub

Sub StopCount()
    Application.OnTime CountDown, "RealCount",, False
End Sub

**jacksten** · 05-17-2012, 02:56 AM

Hi Bob,
This StopCount creates an error 1004 but it does stop the macro "RealCount". When I end this error "RealCount" continues.

Sub StopCount()
   Application.OnTime CountDown, "RealCount", , False
End Sub

I have a "Correct" macro button and a "Wrong" macro button. I run the StopCount as the first action for both of them.

I really appreciate your help with this. It is a Jeopardy Quiz for Senior Citizens where they have a fixed time to answer "RealCount"

If they answer (right or wrong) within the time allowed it stops the countdown. If they don't - they run out of time.

Thanks heaps for taking the time to look at it - if I can get this bit right - the game is ready to go.

Sincerely,

Jack Stenhouse

**Bob Phillips** · 05-17-2012, 03:51 AM

Jack,

I am a bit unclear on what happens. What is the process, what do these people enter, and who clicks the Correct/Wrong buttons? What macros do these buttons fire?

**jacksten** · 05-17-2012, 07:28 PM

Hi Bob,
The idea is that the question is displayed, the countdown starts.Jeopardy Scoring.JPG
I do all of the button pressing. The correct and wrong buttons update the scores of the players.
They both do a fair amount of work . . . an example is . . .

Sub CORRA()
'
' CORRA Macro
'

'
    Application.Goto Reference:="RIGHT"
    ActiveCell.FormulaR1C1 = "Y"
    Application.Goto Reference:="RIGHT"
    Selection.ClearContents
    Application.Goto Reference:="OK"
    Selection.ClearContents
    Application.Goto Reference:="WHO"
    ActiveCell.FormulaR1C1 = "A"
    Application.Goto Reference:="TEMPA"
    ActiveCell.FormulaR1C1 = "Y"
    Application.Goto Reference:="MULTIPLIER"
    ActiveCell.FormulaR1C1 = "1"
    Application.Goto Reference:="FINALA"
    Selection.Copy
    Application.Goto Reference:="PREVA"
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.Goto Reference:="MULTIPLIER"
    Selection.ClearContents
    Application.Goto Reference:="TEMPA"
    Selection.ClearContents
    Sheets("QUESTION").Select
    Application.Goto Reference:="controla"
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Application.Goto Reference:="controlb"
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896
        .ThemeFont = xlThemeFontNone
    End With
    Application.Goto Reference:="controlc"
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896
        .ThemeFont = xlThemeFontNone
    End With
    Application.Goto Reference:="R1C1"
End Sub

Surprisingly . . . they all work except that the clock keeps counting down even when the question is answered.

I appreciate the time you have spent on this. Maybe I should have your StopCount call these macros instead of the other way around?

I have attached an image of the scoring screen - three players - three rights - three wrongs.

The A, B, C buttons identify the person and start the clock.

Again, thanks for your effort.

Sincerely

Jack Stenhouse

**Richard Buttrey** · 05-17-2012, 08:00 PM

...and don't forget the code tags that you correctly used in your earlier post.

**jacksten** · 05-25-2012, 10:57 PM

Hi again Bob,
I am still trying to get this RealCount macro to stop if I press the "correct" or "wrong" macro buttons.
Your "StopCount" macro creates a 1004 error but does seem to stop RealCount.
I know this is only for a game but it would be nice to solve it.
I have attached the Jeopardy file to give you a better idea of what I am trying to achieve.
(I hope this is OK to do?). There is nothing harmful in this file.
The intended use for the game is Senior Citizens and some disabled kids I work with on a voluntary basis.
I appreciate any help you can give me.
Sincerely

Jack Stenhouse

Sub CountUp()
Dim CountDown As Date
    CountDown = Now + TimeValue("00:00:01")
    Application.OnTime CountDown, "RealCount"
End Sub
Sub RealCount()
Dim count As Range
    Set count = [E1]
    count.Value = count.Value - TimeSerial(0, 0, 1)
    If count <= 0 Then
        MsgBox "SORRY - TIME UP!"
        Exit Sub
    End If
    Call CountUp
End Sub

Sub StopCount()
    Application.OnTime CountDown, "RealCount", , False
End Sub