Multiple timer for running a workshop.

[arniej]

Hi All

I am running a spreadsheet to keep track of workshop technician times. The code I am using I have copied and modified from this forum works really well but I need the timer to go in minus time instead of stopping at 00:00:00. It work be really great if the timer cell changed colour it identify that the Technician had run over the allotted time.

Many thanks.

Here is the code that i am currently running.

Moderator's note: Please take the time to review our rules. There aren't many, and they are all important. Rule #3 requires code tags. I have added them for you this time because you are a new member. --6StringJazzer

Option Explicit
Public wSht As Worksheet
Sub StartTimer()
Dim iRow As Integer

Application.Calculation = xlCalculationManual
Set wSht = Sheets("Subject_list")

With TimerUsf
  .SubjList.Clear
  For iRow = 3 To wSht.Cells(2, 1).End(xlDown).Row
    .SubjList.AddItem wSht.Cells(iRow, 1)
  Next iRow
  .CUp = False
  .CDown = False
  .SubjTime = ""
  .Show
End With
Application.Calculation = xlCalculationAutomatic
Beep
End Sub
Sub ClearAll()
Set wSht = Sheets("Subject_list")
wSht.Range("C3:D1000").ClearContents
wSht.Range("C3:C1000").Interior.Color = xlNone
End Sub

Sub AdjustTimer()
Dim TimCount As Integer
Dim iRow As Integer

TimCount = WorksheetFunction.CountA(wSht.Range("D3:D" & Rows.Count))
Do Until TimCount = 0
  For iRow = 3 To wSht.Cells(Rows.Count, 1).End(xlUp).Row
    If wSht.Cells(iRow, 4) <> "" Then
      Select Case wSht.Cells(iRow, 4)
        Case "CountUp"
          wSht.Cells(iRow, 3) = wSht.Cells(iRow, 3) + TimeSerial(0, 0, 1)
          If wSht.Cells(iRow, 3) >= wSht.Cells(iRow, 2) Then
            wSht.Cells(iRow, 4).ClearContents
            wSht.Cells(iRow, 3).Interior.Color = RGB(0, 255, 0)
          End If
        Case "CountDown"
          wSht.Cells(iRow, 3) = wSht.Cells(iRow, 3) - TimeSerial(0, 0, 1)
          If wSht.Cells(iRow, 3) <= TimeValue("00:00:00") Then 'wSht.Cells(iRow, 2) Then
            wSht.Cells(iRow, 4).ClearContents
            wSht.Cells(iRow, 3).Interior.Color = RGB(255, 175, 100)
                     End If
      End Select
    End If
  Next iRow
  TimCount = WorksheetFunction.CountA(wSht.Range("D3:D" & Rows.Count))
  Application.Wait (Now() + TimeSerial(0, 0, 1))
  DoEvents
Loop

End Sub