Countdown Timer

[Mike B.]

Here's the Gist:

I have a certain cell (Q16) can can be a 0 or 1, depending on the logic

If the value in Q16 is 1, I want a cell (W8) to start counting down from 15
to 0 in 1 interval seconds in such a way that I can still perform actions on
other cells.

Then, if the value in Q16 gets changed to 0 before the timer is up, the
timer pauses.

And once again, if the value in Q16 turns back to 1, the clock will start at
15 seconds again till it reaches 0.

I'm very new and have been reading up on Worksheet_Change but I am very
unfamiliar with it. Any help is appreciated.

 

[Bob Phillips]

Add this to a standard code module


Public nCount As Long

Public Sub RunTimer()

If nCount >= 0 Then

Range("W8") = nCount
nCount = nCount - 1
Application.OnTime Now + TimeSerial(0, 0, 1), "RunTimer"
End If
End Sub

and in the worksheet code module add

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "Q16" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target

If .Value = 1 Then

nCount = 15
Call RunTimer
ElseIf .Value = 0 Then

nCount = 0
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Mike B.]

Does this code only work if the Q16 is selected? Is it possible to run the
macro without have Q16 as the active cell?

 

[Bob Phillips]

It works when Q16 is changed directly.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Mike B.]

Is it possible to create a macro that does it even when the the cell isn't
changed directly?

 

[Bob Phillips]

Try this in place of the Change event code

Option Explicit

Const WS_RANGE As String = "Q16" '<== change to suit

Private mPrev As Variant

Private Sub Worksheet_Calculate()

On Error GoTo ws_exit
Application.EnableEvents = False

If Me.Range(WS_RANGE).Value <> mPrev Then

With Me.Range(WS_RANGE)

If .Value = 1 Then

nCount = 15
Call RunTimer
ElseIf .Value = 0 Then

nCount = 0
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
mPrev = Me.Range(WS_RANGE).Value
End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Mike B.]

Thank you very much for your help

Try this in place of the Change event code

Option Explicit

Const WS_RANGE As String = "Q16" '<== change to suit

Private mPrev As Variant

Private Sub Worksheet_Calculate()

On Error GoTo ws_exit
Application.EnableEvents = False

If Me.Range(WS_RANGE).Value <> mPrev Then

With Me.Range(WS_RANGE)

If .Value = 1 Then

nCount = 15
Call RunTimer
ElseIf .Value = 0 Then

nCount = 0
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
mPrev = Me.Range(WS_RANGE).Value
End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)