Excel Countdown

[inplay]

Hello all,
I wan't to start a countdown when the Race turn in play
it should take 20 sek then I want to start betting. I have one which
work but not accurate. Now I set the Time to 8 minutes and it needs only 20 sek
sometimes the countdown run down when the Race is not in Play I want that the time
stay at 20sek when the Race is not in play and it needs 20sek when I say 20sek
Hope somebody can help me.

Think the Problem is the Worksheet Calculate which is here:

Private Sub Worksheet_Calculate()
Static Status As Variant
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
If [E2].Value = "In Play" Then
GoTo Xit
Else
Status = [E2].Value
datTime = TimeSerial(12, 8, 0)
bolTimer = True
Call Countdown
End If
Xit:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub


here is the modul but I think this is ok (':arrow:')


Option Explicit
Option Private Module

Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Public datTime As Date, bolTimer As Boolean

Public Sub Countdown()
If bolTimer Then
datTime = datTime - TimeSerial(0, 0, 1)
With Worksheets("Tabelle1").Cells(2, 23)
.NumberFormat = "m:ss"
.Value = datTime
If datTime > CDate("12:00:01") Then
Application.OnTime Time + TimeSerial(0, 0, 1), "Countdown"
Cells(2, 21) = ""
Else
Cells(2, 21) = "OK"
End If

End With
End If
End Sub

Any help appreciated
Andy

[Mitch]

Are you using this timer so that you know when to start betting, or so that your code knows when to start betting?

[inplay]

I use it that the code knows when to start betting
I have a excel sheet that should back only in play
but when the market open all bets are under 2 so my
sheet will back one horse or all horses whith a small Back price

[Mitch]

I would do it a little bit differently to yours.

I've used X1 for the status and Y1 for when the race went in play, but they can obviously be changed to suit your sheet if you decide to use it.

Code: Select all

Private Sub Worksheet_Calculate()

    If Target.Columns.Count <> 16 Then Exit Sub
    Application.EnableEvents = False
   
    If Cells(2, 5) <> "In Play" Then
        Cells(1, 24) = "NO"
        Cells(1, 25) = ""
        Application.EnableEvents = True
        Exit Sub
    End If
   
    If Cells(1, 24) = "NO" Then
        Cells(1, 24) = "WAIT"
        Cells(1, 25) = Cells(2, 5)
    End If
   
    If Cells(2, 5) - Cells(1, 25) >= TimeSerial(0, 0, 20) Then
        Cells(1, 24) = "OK"
    End If
   
    Application.EnableEvents = True
   
End Sub

I've not tested this but it looks ok I think.

[inplay]

Hello Mitch


I try this the whole time to program.
Unfortunately I am not familiar with VBA and therefore tried it with the countdown.

As I inserted your code, a mistake-news came

"Option is missing", and the first line was yellow marked now, I have the lines:

If Target.Columns.Count < > 16 Then Exit sub
Application.EnableEvents = False

Deleted.

I hope that this doesn't cause any problems in the program.

Then, a small mistake was in the program You copied cell E2 to X1 which is the “in Play” cell.
But we need the clock in X1 which is in cell C2
I had considered the whole time why you copied "in Play."

Unfortunately I could not test it yet because there are no Races today.

But I believe it work.


Thank’s for your help

I will report if it works.

[Mitch]

I didn't recognise that you had used worksheet_calculate and I normally use worksheet_change, so I've changed that in the code below. It could have caused the error because there would be no variable called target.
The first line you deleted is there to prevent the code running too often. It will still work without it but will use the processor much more.
The second line is necessary, it prevents changes the code makes from triggering the macro again. I'm not sure but think it will just run and run and you won't be able to do anything else with it.

You are right about me copying E2 wrongly. As you guessed it should be C2.

These things have been corrected ibelow f you want to copy & paste.

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

    If target.Columns.Count <> 16 Then Exit Sub
    Application.EnableEvents = False
   
    If Cells(2, 5) <> "In Play" Then
        Cells(1, 24) = "NO"
        Cells(1, 25) = ""
        Application.EnableEvents = True
        Exit Sub
    End If
   
    If Cells(1, 24) = "NO" Then
        Cells(1, 24) = "WAIT"
        Cells(1, 25) = Cells(2, 3)
    End If
   
    If Cells(2, 3) - Cells(1, 25) >= TimeSerial(0, 0, 20) Then
        Cells(1, 24) = "OK"
    End If
   
    Application.EnableEvents = True
   
End Sub

I would recommend making a copy of your workbook (so you can go back to yours if you need to), then deleting all the code you have in it, then pasting my code into the worksheet code window. This is to make sure your code and my code are not clashing with each other.

Please let me know how you get on with it.

[inplay]

Hello Mitch

I thought worksheet_change only worked if I does some Input by hand and therefore used worksheet_calculate.

But now perfect.

The last code you post perfectly worked I could take it exactly so.

Much thanks for your help.

Maybe I can get ...... someday.

Cheers
Andy

[Mitch]

I'm glad I could help Andy......

..... and I hope the revenge thing is a bad translation

[inplay]

was a very bad translation i have to buy a new dictionary

it should mean

to get one's own back (on)
to return the favour (favour)
to pay someone back
to take revenge (on)

I have this four in the Dictionary and take the last

don't know that it was a bad word sorry Mitch

Cheers Andy

[Mitch]

No problem, I knew what you meant.

Also, your English is far better than my <insert your language here>