Independent Timer Macros in Excel Worksheets

So I used a simple timer macro that I found online that basically uses a start and stop button to keep track of time. However, I want to use the timers so they work independently on each sheet. So if I have 2 worksheets, if I start the timer on one sheet, it keeps running on that sheet and I can switch to the second worksheet and start the timer on that sheet separately. Currently, the way the macro is working is that starting the timer on one worksheet keeps a running time on both sheets and will stop if either stop button is pressed on either sheet. Here is what I have currently:

Sub StartTimer()
Dim Start As Single, RunTime As Single
Dim ElapsedTime As String
Dim counter As Long

'Set the control cell to 0 and make it green
Range("C1").Value = 0
Range("A1").Interior.Color = 5296274  'Green

counter = 0
Start = Timer 'Set start time.
Debug.Print Start
Do While Range("C1").Value = 0

    DoEvents 'Yield to other processes.
    RunTime = Timer 'Current elapsed time
    ElapsedTime = Format((RunTime - Start) / 86400, "hh:mm:ss")
    'Display currently elapsed time in A1
    Range("A1").Value = ElapsedTime
    Application.StatusBar = ElapsedTime

Loop

Range("A1").Value = ElapsedTime
Range("A1").Interior.Color = 192 'Dark red
Application.StatusBar = False

End Sub

Sub StopTimer()

    'Set the control cell to 1
    Range("C1").Value = 1

End Sub

Sub ResetTimer()
    If Range("C1").Value > 0 Then

    'Set the control cell to 1
    Range("A1").Value = Format(0, "hh:mm:ss")

    End If

End Sub

Solution

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