Problem Running multiple timers in MS excel using VBA - excel

Question

I am trying to run multiple timers in different cells in MS excel. I want to stop the timer only on the selected active cell.
The problem is when I am starting the timer on another cell. The previous timer on a previously chosen cell automatically stops.
The program I have now starts the timer upon double clicking.
I am trying to run different timers on the different cells and I want to stop the timer on the selected cells only using macros.
Here is what I have done so far:
The functions have been assigned to macros.
For a clearer explanation, let's say I start the timer in Cell A1 by double clicking(as coded in my worksheet). Now, if I start the timer in Cell A2, then the timer in A1 stops, and the timer in A2 runs. I want to run both the timers and stop the timer on the cell I select only while the other should still run.
I am scratching my head as to how I should modify my code to achieve this.
Option Explicit
Dim Tick As Date, t As Date
Global myCell As Range
Sub stopwatch()
t = Time
Call StartTimer
End Sub
Sub StartTimer()
Tick = Time + TimeValue("00:00:01")
myCell.Value = Format(Tick - t - TimeValue("00:00:01"), "hh:mm:ss")
Application.OnTime Tick, "StartTimer"
End Sub
Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=Tick, Procedure:="StartTimer", Schedule:=False
End Sub
In my Worksheet , I have this code to start the timer on double click:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set myCell = Target
StartTimer
Cancel = True
End Sub

Answer 1

Try this - using a Dictionary to track which cells have timers running.
Double-click a cell to start a timer there: double-click again to stop.
This code is all in the Sheet3 module (codename)
Option Explicit
Dim timers As Object 'cell addresses as keys and start times as values
Dim nextTime 'next run time
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
ToggleTimer Target
Cancel = True
End Sub
Sub ToggleTimer(Optional c As Range = Nothing)
Dim addr As String, k, macro
If timers Is Nothing Then Set timers = CreateObject("scripting.dictionary")
macro = Me.CodeName & ".ToggleTimer"
On Error Resume Next 'cancel any running timer
Application.OnTime EarliestTime:=nextTime, Procedure:=macro, Schedule:=False
On Error GoTo 0
If Not c Is Nothing Then '? called from a cell double-click ?
addr = c.Address(False, False)
If timers.exists(addr) Then
timers.Remove addr ' timer was running - remove it
Else
timers(addr) = Now ' timer was not running - add it
End If
End If
If timers.Count = 0 Then Exit Sub 'no more timers
For Each k In timers 'update timer(s)
Me.Range(k).Value = Format(Now - timers(k), "hh:mm:ss")
Next k
'schedule next run
nextTime = Now + TimeSerial(0, 0, 1)
Application.OnTime nextTime, Me.CodeName & ".ToggleTimer"
Debug.Print Me.CodeName
End Sub