![]() |
Countdown Timer
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. |
Countdown Timer
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." <Mike wrote in message ... 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. |
Countdown Timer
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" wrote: 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) |
Countdown Timer
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." wrote in message ... 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" wrote: 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) |
Countdown Timer
Is it possible to create a macro that does it even when the the cell isn't
changed directly? "Bob Phillips" wrote: 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." wrote in message ... 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" wrote: 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) |
Countdown Timer
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." wrote in message ... Is it possible to create a macro that does it even when the the cell isn't changed directly? "Bob Phillips" wrote: 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." wrote in message ... 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" wrote: 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) |
Countdown Timer
Thank you very much for your help
"Bob Phillips" wrote: 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." wrote in message ... Is it possible to create a macro that does it even when the the cell isn't changed directly? "Bob Phillips" wrote: 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." wrote in message ... 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" wrote: 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) |
All times are GMT +1. The time now is 02:56 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com