Best way to make multiple countdown timers

**Dave_ross** · 11-28-2011, 09:50 AM

hi guys what is the best way to make multiple countdown timers on one worksheet? i.e i want one counter counting down to zero. when it reaches zero i want another counter to automatically start counting down? is this possible?

**pike** · 11-29-2011, 03:44 AM

Hi Dave_ross

Try......

Dim iTimer
Dim iiTimer
Dim iiiTimer
Dim zTimer
Dim xCount
Sub start_timers()
    ThisWorkbook.Sheets(1).Range("B2") = 5
    ThisWorkbook.Sheets(1).Range("C2") = 5
    ThisWorkbook.Sheets(1).Range("D2") = 5
    ThisWorkbook.Sheets(1).Range("E2") = ""
    ThisWorkbook.Sheets(1).Range("A2") = "Started"
    MasterTimer
End Sub
Sub MasterTimer()
    xCount = 5
    If ThisWorkbook.Sheets(1).Range("B2") > 4 Then
        UpdateiTimer
        STimer
    ElseIf ThisWorkbook.Sheets(1).Range("C2") > 4 Then
        UpdateiiTimer
        STimer
    ElseIf ThisWorkbook.Sheets(1).Range("D2") > 4 Then
        UpdateiiiTimer
        STimer
    Else
        KillTimers
    End If
End Sub
Sub UpdateiTimer()
    ThisWorkbook.Sheets(1).Range("B2") = xCount
    iTimer = Now + TimeValue("00:00:01")
    xCount = xCount - 1
    Application.OnTime iTimer, "UpdateiTimer"
End Sub
Sub UpdateiiTimer()
    ThisWorkbook.Sheets(1).Range("C2") = xCount
    iiTimer = Now + TimeValue("00:00:01")
    xCount = xCount - 1
    Application.OnTime iiTimer, "UpdateiiTimer"
End Sub
Sub UpdateiiiTimer()
    ThisWorkbook.Sheets(1).Range("D2") = xCount
    iiiTimer = Now + TimeValue("00:00:01")
    xCount = xCount - 1
    Application.OnTime iiiTimer, "UpdateiiiTimer"
End Sub
Sub STimer()
    zTimer = Now + TimeValue("00:00:05")
    Application.OnTime zTimer, "StopTimers"
End Sub
Sub StopTimers()
    On Error Resume Next
    Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime iiTimer, "UpdateiiTimer", , False
    Application.OnTime iiiTimer, "UpdateiiiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    MasterTimer
End Sub
Sub KillTimers()
    On Error Resume Next
    Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime iiTimer, "UpdateiiTimer", , False
    Application.OnTime iiiTimer, "UpdateiiiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    ThisWorkbook.Sheets(1).Range("E2") = "Stopped"
    ThisWorkbook.Sheets(1).Range("A2") = ""
End Sub

add this to make sure thetimer is stopped before close

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Call KillTimers
End Sub

**Dave_ross** · 11-29-2011, 05:16 AM

thats great. i should be able to adapt the cell numbers to the cell i need. Ill let you know if i manage. my excel skills are limited he he

**pike** · 11-29-2011, 05:26 AM

once you get your head around the code it can be shortened to

Option Explicit
Dim iTimer as date
Dim zTimer as date
Dim xCount As Long
Dim xCell As Range
Sub start_timers()
    With ThisWorkbook.Sheets(1)
        .Range("B2") = 5
        .Range("C2") = 5
        .Range("D2") = 5
        .Range("E2") = ""
        .Range("A2") = "Started"
    End With
    MasterTimer
End Sub
Sub MasterTimer()
    xCount = 5
    If ThisWorkbook.Sheets(1).Range("B2") > 4 Then
        Set xCell = ThisWorkbook.Sheets(1).Range("B2")
        UpdateiTimer
        STimer
    ElseIf ThisWorkbook.Sheets(1).Range("C2") > 4 Then
        Set xCell = ThisWorkbook.Sheets(1).Range("c2")
        UpdateiTimer
        STimer
    ElseIf ThisWorkbook.Sheets(1).Range("D2") > 4 Then
        Set xCell = ThisWorkbook.Sheets(1).Range("d2")
        UpdateiTimer
        STimer
    Else
        Set xCell = Nothing
        KillTimers
    End If
End Sub
Sub UpdateiTimer()
    xCell = xCount
    iTimer = Now + TimeValue("00:00:01")
    xCount = xCount - 1
    Application.OnTime iTimer, "UpdateiTimer"
End Sub
Sub STimer()
    zTimer = Now + TimeValue("00:00:05")
    Application.OnTime zTimer, "StopTimers"
End Sub
Sub StopTimers()
    On Error Resume Next
    Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    MasterTimer
End Sub
Sub KillTimers()
    On Error Resume Next
    Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    ThisWorkbook.Sheets(1).Range("E2") = "Stopped"
    ThisWorkbook.Sheets(1).Range("A2") = ""
End Sub

**Dave_ross** · 11-29-2011, 05:38 AM

ill see what i can do. i have attached what im working on to show you what im up too. thanks for your help

**pike** · 11-29-2011, 06:37 AM

you could

format cells custom
00":"00":"00
then you are dealing with numbers not times

**pike** · 11-29-2011, 07:22 AM

with
cells B2 C2 D2 formated as custom Format pattern
00":"00":"00

Option Explicit
Dim iTimer As Date
Dim zTimer As Date
Dim xCount As Long
Dim iCount As Long
Dim xCell As Range
Dim eTime
Sub start_timers()
    With ThisWorkbook.Sheets(1)
        .Range("B2") = 5
        .Range("C2") = 10
        .Range("D2") = 150
        .Range("E2") = ""
        .Range("A2") = "Started"
    End With
    MasterTimer
End Sub
Sub MasterTimer()

    If ThisWorkbook.Sheets(1).Range("B2") > 4 Then
        xCount = 5
        Set xCell = ThisWorkbook.Sheets(1).Range("B2")
        eTime = TimeValue("00:00:05")
        iCount = 1
        UpdateiTimer
        STimer
    ElseIf ThisWorkbook.Sheets(1).Range("C2") > 4 Then
        xCount = 10
        iCount = 1
        Set xCell = ThisWorkbook.Sheets(1).Range("c2")
        eTime = TimeValue("00:00:10")
        UpdateiTimer
        STimer
    ElseIf ThisWorkbook.Sheets(1).Range("D2") > 4 Then
        xCount = 150
        iCount = 3
        Set xCell = ThisWorkbook.Sheets(1).Range("d2")
        eTime = TimeValue("00:00:50")
        UpdateiTimer
        STimer
    Else
        KillTimers
    End If
End Sub
Sub UpdateiTimer()
    xCell = xCount
    iTimer = Now + TimeValue("00:00:01")
    xCount = xCount - iCount
    Application.OnTime iTimer, "UpdateiTimer"
End Sub
Sub STimer()
    zTimer = Now + eTime
    Application.OnTime zTimer, "StopTimers"
End Sub
Sub StopTimers()
    On Error Resume Next
    Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    MasterTimer
End Sub
Sub KillTimers()
    On Error Resume Next
    Set xCell = Nothing
     Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    ThisWorkbook.Sheets(1).Range("E2") = "Stopped"
    ThisWorkbook.Sheets(1).Range("A2") = ""
End Sub

**Dave_ross** · 11-29-2011, 07:46 AM

this version is not counting down in time format? i.e 00:01:59. this one is doing 00:00:99?

**pike** · 11-30-2011, 02:11 AM

Hi Dave_ross
Try this code in you workbook

Option Explicit
Dim iTimer As Date
Dim zTimer As Date
Dim xCount As Date
Dim iCount As Date
Dim eTime As Date
  Dim XCell As Range
Dim iBoolean As Boolean
Dim iiBoolean As Boolean
Dim iiiBoolean As Boolean
Sub start_timers()
    With ThisWorkbook.Sheets(1)
        .Range("C3") = TimeValue("00:00:10")
        .Range("E3") = TimeValue("00:00:10")
        .Range("G3") = TimeValue("00:01:50")
        .Range("G10") = ""
        .Range("C10") = "Started"
    End With
  iBoolean = True
iiBoolean = True
iiiBoolean = True
    MasterTimer
End Sub
Sub MasterTimer()
  
    
    If iBoolean Then
        xCount = TimeValue("00:00:10")
        Set XCell = ThisWorkbook.Sheets(1).Range("C3")
        eTime = TimeValue("00:00:10")
        iCount = TimeValue("00:00:01")
        iBoolean = False
        UpdateiTimer
        STimer
    ElseIf iiBoolean Then
        xCount = TimeValue("00:00:10")
        iCount = TimeValue("00:00:01")
        Set XCell = ThisWorkbook.Sheets(1).Range("E3")
        eTime = TimeValue("00:00:10")
         iiBoolean = False
        UpdateiTimer
        STimer
    ElseIf iiiBoolean Then
        xCount = TimeValue("00:01:50")
        iCount = TimeValue("00:00:01")
        Set XCell = ThisWorkbook.Sheets(1).Range("G3")
        eTime = TimeValue("00:01:50")
         iiiBoolean = False
        UpdateiTimer
        STimer
    Else
        KillTimers
    End If
End Sub
Sub UpdateiTimer()
    XCell = xCount
    iTimer = Now + TimeValue("00:00:01")
    xCount = xCount - iCount
    Application.OnTime iTimer, "UpdateiTimer"
End Sub
Sub STimer()
    zTimer = Now + eTime
    Application.OnTime zTimer, "StopTimers"
End Sub
Sub StopTimers()
    On Error Resume Next
    Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    MasterTimer
End Sub
Sub KillTimers()
    On Error Resume Next
    Set XCell = Nothing
     Application.OnTime iTimer, "UpdateiTimer", , False
    Application.OnTime zTimer, "STimer", , False
    ThisWorkbook.Sheets(1).Range("G10") = "Stopped"
    ThisWorkbook.Sheets(1).Range("C10") = ""
End Sub

but dont forget to put

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Call KillTimers
End Sub

in "Thisworkbook" Module

**Dave_ross** · 11-30-2011, 07:38 AM

Perfect thanks

**Dave_ross** · 11-30-2011, 12:56 PM

Thats great works a dream.

really gonna pick your brains now though...

What if i wanted to have these count down timers running but also have others running in other rows? do i create a new module with the correct cell numbers? I tried this and its telling me i have ambiguous names?

i want each row of counters to work independently if i can?

ill attach a copy to show you

**pike** · 11-30-2011, 02:30 PM

Try changing the names in the new module by adding a One Or Two to the end of wall the variables sub etc... Module two will all have two at end

**pike** · 12-01-2011, 02:41 AM

Hi Dave_ross
it will get very long

probably better to use one timer that controls all the off events

Option Explicit
Dim iTimer As Date
Dim zTimer As Date
Dim xCount As Date
Dim iCount As Date
Dim eTime As Date
Dim XCell As Range
Dim iBoolean As Boolean
Dim iiBoolean As Boolean
Dim iiiBoolean As Boolean
Dim iiiiBoolean As Boolean
Dim iTimer1 As Date
Dim zTimer1 As Date
Dim xCount1 As Date
Dim iCount1 As Date
Dim eTime1 As Date
Dim xcell1 As Range
Dim iBoolean1 As Boolean
Dim iiBoolean11 As Boolean
Dim iiiBoolean111 As Boolean
Dim iiiiBoolean1111 As Boolean
Sub start_timers()
With ThisWorkbook.Sheets(1)
.Range("C3") = TimeValue("00:00:10")
.Range("E3") = TimeValue("00:00:10")
.Range("G3,I3") = TimeValue("00:00:10")
.Range("K3") = TimeValue("03:00:10")
End With
iBoolean = True
iiBoolean = True
iiiBoolean = True
iiiiBoolean = True
MasterTimer
End Sub
Sub start_timers1()
With ThisWorkbook.Sheets(1)
.Range("C3") = TimeValue("00:00:10")
.Range("E3") = TimeValue("00:00:10")
.Range("G3,I3") = TimeValue("00:00:10")
.Range("K3") = TimeValue("03:00:10")
End With
iBoolean1 = True
iiBoolean11 = True
iiiBoolean111 = True
iiiiBoolean1111 = True
MasterTimer1
End Sub
Sub MasterTimer()
If iBoolean Then
xCount = TimeValue("00:00:10")
Set XCell = ThisWorkbook.Sheets(1).Range("C3")
eTime = TimeValue("00:00:10")
iCount = TimeValue("00:00:01")
iBoolean = False
UpdateiTimer
STimer
ElseIf iiBoolean Then
xCount = TimeValue("00:00:10")
iCount = TimeValue("00:00:01")
Set XCell = ThisWorkbook.Sheets(1).Range("E3")
eTime = TimeValue("00:00:10")
iiBoolean = False
UpdateiTimer
STimer
ElseIf iiiBoolean Then
xCount = TimeValue("00:00:10")
iCount = TimeValue("00:00:01")
Set XCell = ThisWorkbook.Sheets(1).Range("G3,I3")
eTime = TimeValue("00:00:10")
iiiBoolean = False
UpdateiTimer
STimer
ElseIf iiiiBoolean Then
xCount = TimeValue("03:00:10")
iCount = TimeValue("00:00:01")
Set XCell = ThisWorkbook.Sheets(1).Range("K3")
eTime = TimeValue("03:00:10")
iiiiBoolean = False
UpdateiTimer
STimer
Else
KillTimers
End If
End Sub
Sub UpdateiTimer()
XCell = xCount
iTimer = Now + TimeValue("00:00:01")
xCount = xCount - iCount
Application.OnTime iTimer, "UpdateiTimer"
End Sub
Sub STimer()
zTimer = Now + eTime
Application.OnTime zTimer, "StopTimers"
End Sub
Sub StopTimers()
On Error Resume Next
Application.OnTime iTimer, "UpdateiTimer", , False
Application.OnTime zTimer, "STimer", , False
MasterTimer
End Sub
Sub KillTimers()
On Error Resume Next
Set XCell = Nothing
 Application.OnTime iTimer, "UpdateiTimer", , False
Application.OnTime zTimer, "STimer", , False
End Sub

Sub MasterTimer1()
If iBoolean1 Then
xCount1 = TimeValue("00:00:10")
Set xcell1 = ThisWorkbook.Sheets(1).Range("C6")
eTime1 = TimeValue("00:00:10")
iCount1 = TimeValue("00:00:01")
iBoolean1 = False
UpdateiTimer1
STimer1
ElseIf iiBoolean11 Then
xCount1 = TimeValue("00:00:10")
iCount1 = TimeValue("00:00:01")
Set xcell1 = ThisWorkbook.Sheets(1).Range("E6")
eTime1 = TimeValue("00:00:10")
iiBoolean11 = False
UpdateiTimer1
STimer1
ElseIf iiiBoolean111 Then
xCount1 = TimeValue("00:00:10")
iCount1 = TimeValue("00:00:01")
Set xcell1 = ThisWorkbook.Sheets(1).Range("G6,I6")
eTime1 = TimeValue("00:00:10")
iiiBoolean111 = False
UpdateiTimer1
STimer1
ElseIf iiiiBoolean1111 Then
xCount1 = TimeValue("03:00:10")
iCount1 = TimeValue("00:00:01")
Set xcell1 = ThisWorkbook.Sheets(1).Range("K6")
eTime1 = TimeValue("03:00:10")
iiiiBoolean1111 = False
UpdateiTimer1
STimer1
Else
KillTimers1
End If
End Sub
Sub UpdateiTimer1()
xcell1 = xCount1
iTimer1 = Now + TimeValue("00:00:01")
xCount1 = xCount1 - iCount1
Application.OnTime iTimer1, "UpdateiTimer1"
End Sub
Sub STimer1()
zTimer1 = Now + eTime1
Application.OnTime zTimer1, "StopTimers1"
End Sub
Sub StopTimers1()
On Error Resume Next
Application.OnTime iTimer1, "UpdateiTimer1", , False
Application.OnTime zTimer1, "STimer1", , False
MasterTimer1
End Sub
Sub KillTimers1()
On Error Resume Next
Set xcell1 = Nothing
 Application.OnTime iTimer1, "UpdateiTimer1", , False
Application.OnTime zTimer1, "STimer1", , False
End Sub

**Dave_ross** · 12-01-2011, 05:09 AM

Pike you are just the best!!

Thanks alot for your help

**Dave_ross** · 02-22-2012, 06:17 AM

hi i have been using the above code for a couple of months now but i notice that if it is left for an hour or so the timers stop & dont always reach zero?
what can i do to stop the timers stopping prematurely? because if they do it knocks everything off

**ronald coletto** · 10-10-2012, 02:02 PM

guys i have seen you multiple countdown timer i need to be able to create multiple count downs in various cell please advise how i have put in a file and i would like to be able to add in p5 p6 p7 and so on

please help !!!!!

ronald coletto

**Dawnrb58** · 02-04-2019, 04:21 PM

I want multiple timers running independently of each other in column M, Starting with M2.

**arlu1201** · 10-10-2012, 03:02 PM

Ronald,

Unfortunately you need to post your question in a new thread, it's against the forum rules to post a question in the thread of another user. If you create your own thread, any advice will be tailored to your situation so you should include a description of what you've done and are trying to do. Also, if you feel that this thread is particularly relevant to what you are trying to do, you can surely include a link to it in your new thread.

**ronald coletto** · 10-11-2012, 09:36 AM

sorry i am new to postings i will create a new one
sorry guys

**FDibbins** · 02-04-2019, 05:06 PM

Dawn, welcome to the forum

Did you perhaps not notice post #17?

Best way to make multiple countdown timers

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Re: Best way to make multiple countdown timers

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions