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

Add to commandbuttons to your sheet and place the code below in that sheet.

Andreas.

Option Explicit

Dim StopTimer As Boolean

Private Sub CommandButton1_Click()

  'Start the timer

  Const Minutes = 20

  Dim EndTime As Double

  StopTimer = False

  Do

    If EndTime - Now < 0 Then

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

    End If

    Range("A1") = EndTime - Now

    DoEvents

  Loop Until StopTimer

End Sub

Private Sub CommandButton2_Click()

  'Stops the timer

  StopTimer = True

End Sub

Answer 2

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?

a) No. If you edit a cell, Excel disables all macros.

b) Change the line

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

to

  MsgBox "Countdown Complete"

  Exit Sub

Andreas.

Answer 3

but I want not repeat with single commandbutton "START" and cell to input timer.

If you tell me what you want, instead of what you not want, then I can try to help you. ;-)

Andreas.

Answer 4

Is this possible at all. I may need to add 2 more buttons called Pause Timer and Restart Timer. The Stop Button will only be used at the end of the day. We need to be able to Pause the loop timer and restart it again when people are at lunch or tea break.

There is not really a need for two more buttons, because the stop button can reset our internal timer and we can use this as indicator how the start button should act.

If the start button is clicked, the timer is initialized and starts, it shows the caption "Pause".

If clicked again, the timer pauses and the button shows "Continue".

If clicked again, the timer continues and the button shows "Pause".

The button toggles in this behavior until you click the stop button.

If the stop button is clicked, the start button shows the caption "Start", stops the timer, reset cell to zero, as usual.

Don't worry if you forget to click the stop button at the end of the day, click it the next morning and everything is okay.

To increase a counter when the timer resets is very easy, have a look at the sub Initialize().

I made a little change with the cell who holds the TimerValue, you must setup this cell with a date/time format and enter the time in this format, i.E.: 0:10:00 for a 10 minute countdown. This allows you to have a more flexible counter, it counts now any value from 1 second up to several hours (and more).

I've added some comments and renamed the timersub, so it is easier for your to read and understand what happen in the macros, I hope. :-)

Place this code in the code module of the sheet:

--- schnipp ---

Option Explicit

Private Captions(-1 To 1) As String

Private Sub Initialize()

  'We need to init only if this cell is Nothing

  If TimerCell Is Nothing Then

    'Setup the cell where the timer is shown

    Set TimerCell = Range("A2")

    'Setup the cell where the timer get the countdown value

    Set TimerValue = Range("B2")

    'Setup the cell to show the counts

    Set TimerCounter = Range("C2")

    'Setup the altering captions of the first commandbutton

    Captions(1) = "Start"

    Captions(False) = "Pause"

    Captions(True) = "Continue"

  End If

End Sub

Private Sub CommandButton1_Click()

  'Starts, pauses or continues the timer

  'Make sure our cells are initialized

  Initialize

  'How should we act?

  If EndTime = 0 Then

    'Keep timer running

    StopTimer = False

    'Call our timer

    ShowTimer

  Else

    'Toggle the timer state

    StopTimer = Not StopTimer

    'Did we have to continue the timer?

    If Not StopTimer Then

      'Calculate new endtime

      EndTime = Now + TimerCell

      'Call our timer

      ShowTimer

    End If

  End If

  'Set caption to next action

  CommandButton1.Caption = Captions(StopTimer)

End Sub

Private Sub CommandButton2_Click()

  'Stops the timer

  'Make sure our cells are initialized

  Initialize

  'Force timer to stop

  StopTimer = True

  'Reset cell to zero

  TimerCell = 0

  'Reset our internal time

  EndTime = 0

  'Force the caption of the first button

  CommandButton1.Caption = Captions(1)

End Sub

--- schnapp ---

And this code in the normal code module:

--- schnipp ---

Option Explicit

'Avoids that the user can call our sub directly

Option Private Module

Public TimerCell As Range

Public TimerValue As Range

Public TimerCounter As Range

Public StopTimer As Boolean

Public EndTime As Double

Public Sub ShowTimer()

  'Timer running?

  If Not StopTimer Then

    'To avoid an event every second!

    Application.EnableEvents = False

    'Time over?

    If EndTime - Now < 0 Then

      'Increase counted value only after first run

      If EndTime > 0 Then TimerCounter = TimerCounter + 1

      'Calculate next endtime

      EndTime = Now + TimerValue

    End If

    'Show remaining time

    TimerCell = EndTime - Now

    'Enable the events

    Application.EnableEvents = True

    'Force excel to call ourself in one second

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

  End If

End Sub

--- schnapp ---

I hope this come across with your imagining.

Andreas.

Answer 5

I will need to be able to enter data into other cells but when i try to tpe something it automatically stops the timer. The timer will be running in a loop for hours at a time and during that time other cells need to be popoualted with other production information.

It is not possible to get the timer counting if you edit a cell, because excel stops all macros at this time. If you want to keep the counter running, you have to start excel two times and open the file whit the counter stand alone. Then use the other excel application for your work.

Another better idea is to force the counter to execute only 1 time every second. The counter stops if you edit a cell anyway, but if you are finished it shows the correct time, like that he has counting in the background.

Look at CommandButton1_Click() to setup your cells, remove the old code and place this code in the code module of the sheet:

--- 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.