You can accomplish this by keeping track of which worksheets have running timers. I've used a Dictionary with early binding, so you'll have to add the library reference to use the example code below.
The idea is that you have a "list" of which worksheets in your workbook have active timers. In terms of a Dictionary it means that if the sheet has a timer, then there is an entry in the Dictionary. To set this up in its own module, I have defined the following global constants and variable:
Private Const FIXED_CELL As String = "C20"
Private Const STATUS_CELL As String = "D20"
Private Const UPDATE_INTERVAL As String = "00:00:01"
Private sheetTimers As Dictionary
The sheetTimers dictionary will be used by all the routines in the module. The constants are a good idea because it gives you a single place to make a change.
The set up in your workbook is to create Start and Stop buttons on multiple worksheets, plus a few cells to display the elapsed time. The buttons will each assign to the appropriate Public Sub.
There is code in each of the subs that help to keep track of the timers and control the setting of the next UpdateAllTimers event to update the elapsed time. You can modify the example code to add cell color and other features as needed.
Option Explicit
Private Const ELAPSED_CELL As String = "C5"
Private Const STATUS_CELL As String = "D5"
Private Const UPDATE_INTERVAL As String = "00:00:01"
Private sheetTimers As Dictionary
Private timerIsActive As Boolean
Public Sub UpdateAllTimers()
If sheetTimers Is Nothing Then
timerIsActive = False
Else
'Debug.Print sheetTimers.Count & " timers are running"
If sheetTimers.Count > 0 Then
Dim sheetName As Variant
For Each sheetName In sheetTimers.Keys
UpdateElapsedTime sheetName, sheetTimers(sheetName), Now()
Next sheetName
Application.OnTime Now() + TimeValue(UPDATE_INTERVAL), "UpdateAllTimers"
timerIsActive = True
Else
timerIsActive = False
End If
End If
End Sub
Sub StartTimer()
'--- first time initialization ONLY
If sheetTimers Is Nothing Then Set sheetTimers = New Dictionary
'--- find or create the entry for the ACTIVE worksheet
Dim thisSheet As Worksheet
Dim thisSheetName As String
Set thisSheet = ActiveSheet
thisSheetName = thisSheet.Name
If sheetTimers.Exists(thisSheetName) Then
ResetTimer
Else
sheetTimers.Add thisSheetName, Now()
thisSheet.Range(ELAPSED_CELL).value = TimeValue("00:00:00")
thisSheet.Range(STATUS_CELL).value = "Running"
End If
If Not timerIsActive Then
Application.OnTime Now() + TimeValue(UPDATE_INTERVAL), "UpdateAllTimers"
End If
End Sub
Sub StopTimer()
If sheetTimers Is Nothing Then
timerIsActive = False
Else
'--- update the elapsed time value one last time and delete the
' entry in the dictionary
Dim thisSheet As Worksheet
Set thisSheet = ActiveSheet
Dim thisSheetName As String
thisSheetName = thisSheet.Name
If sheetTimers.Exists(thisSheetName) Then
UpdateElapsedTime thisSheetName, sheetTimers(thisSheetName), Now()
sheetTimers.Remove thisSheetName
thisSheet.Range(STATUS_CELL).value = "Stopped"
Else
'--- do nothing, this sheet's timer was never started
End If
End If
End Sub
Private Sub UpdateElapsedTime(ByVal sheetName As String, _
ByVal startTime As Date, _
ByVal endTime As Date)
Dim elapsedTime As Range
Set elapsedTime = ThisWorkbook.Sheets(sheetName).Range(ELAPSED_CELL)
elapsedTime.NumberFormat = "hh:mm:ss.0" 'optional
elapsedTime.value = endTime - startTime
End Sub
Sub ResetTimer()
'--- update the start time value on for the active worksheet
' entry in the dictionary
Dim thisSheet As Worksheet
Set thisSheet = ActiveSheet
Dim thisSheetName As String
thisSheetName = thisSheet.Name
If sheetTimers.Exists(thisSheetName) Then
sheetTimers(thisSheetName) = Now()
UpdateElapsedTime thisSheetName, sheetTimers(thisSheetName), Now()
sheetTimers.Remove thisSheetName
Else
'--- do nothing, this sheet's timer was never started
End If
End Sub
