VBA code to run repeat countdown timer in excel

Question

All

I require some VBA code which will run a countdown timer in a cell in an excel sheet. In our factory we have a Takt time which dictates how often a finished product is produced. Basically if we have 1000 mins available work time each day and we have to build 100 units per day then our takt time would be 10 mins. One finished product should come off the assembly line every 10 mins.

I would like to have an excel spreadhseet which would be linked to a large flat screen monitor which will display daily production information. In the sheet I would like to have a countdown timer which will run based on the takt time. If like the example above the takt time is 10 mins I would like the worksheet cell to countdown from  20mins to 0.and when it gets to 0 it would refresh and start from 20 mins again automatically. I would like the macro to be linked to a command button called 'Start' which would be clicked at the start of the shift, and the countdown will run repeatidly all day and then a second button called 'Stop' which will stop the timer. I would also need to ensure that the spreadsheet can be edited and other cells can be populated with information / data whilst the countdown is running. 

Is any of this possible? I have seen some examples of countdown timers but nothing to what I really need. Any help would be great. I have office 2003 but most employees here have 2000 so it would need to be compatible with both versions. Thanks.

Answer 1

--- schnipp ---

Option Explicit

Private Sub CommandButton1_Click()

  'Starts the timer

 

  'Setup the cell where the timer is shown

  Set TimerCell = Range("A1")

  'Setup the cell where the timer get the countdown value

  Set TimerValue = Range("B1")

 

  'Force timer to reset

  EndTime = 0

  'Keep timer running

  StopTimer = False

  'Call our timer

  TimeCounter

End Sub

Private Sub CommandButton2_Click()

  'Stops the timer

  StopTimer = True

End Sub

--- schnapp ---

Add a normal module to your project and insert this code in there:

--- schnipp ---

Option Explicit

Public TimerCell As Range

Public TimerValue As Range

Public StopTimer As Boolean

Public EndTime As Double

Public Sub TimeCounter()

  If Not StopTimer Then

    If EndTime - Now < 0 Then

      EndTime = Now + TimeSerial(0, TimerValue, 0)

    End If

    Application.EnableEvents = False

    TimerCell = EndTime - Now

    Application.EnableEvents = True

    Application.OnTime Now + TimeSerial(0, 0, 1), "TimeCounter"

  End If

End Sub

--- schnapp ---

Andreas.

I love this code. I like that I can change cells while the macro is running. Is there a way to make this without the loop? I was wondering if rather than the count starting over at 0, if it could have a pop-up message that says "Countdown Complete" instead?

Answer 2

Thanks for your help. I try it.