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
Bookmarks