A timer for VBA Excel

Updated Klahr_R 0 3K Views

A simple timer for Excel VBA

Excel VBA does not have a timer control. The alternative is to use the Timer() Function, and that leaves much to be desired.
This code should be placed in a code module.

My need was to tend to an abandoned program that was waiting for user input. I used this timer so that, if time elapsed, dummy data could be entered and the application saved and closed. The problem(s) with using Timer Function is that each call starts a new timer. If the timer times out after the application has closed, the application will/can reopen to execute the sub specified in the call. It is easy to get more than one instance of the same event timing. If the first call has not yet timed out a second instance will start. Each instance will execute the associated sub causing no end of problems.

This timer uses three subs to resolve these problems. Timer_Start starts the timer which, as written, will run for only 1 second then calls CheckTime which will determine what happens next. Calling the timer in the workbook_close event, with an interval of 0 (zero) along with the 1 second interval ensure the timer is dead when the workbook closes. CheckTime checks for remaining time, and can start user notification if desired. StartTiming is called from anywhere in the project. The Sub can be called with Integer "Interval" = 0 to stop the timer. The maximum time is limited to the range of the Interger data type (32,767 which is just over 9 hours). If the timer is being called with time left on the first call, MyCount simply takes the new value of Interval with out having to start a new instance of Timer

Option Explicit

Dim MyCount As Integer 'The number of seconds to be counted
Dim TimerEnabled As Boolean ' Alternate means to stop counting

Sub StartTiming(Interval As Integer)

	MyCount = Interval
	'This is the sub that will be called to start the timing process
	'The number of seconds to count down is passed throught "Interval"
    ' If timer called when alread executing, a second timer will start--NOT GOOD
    ' start the timer with the specified interval
    'CALL CHECKTIME INSTEAD OF CALLING TIMER

	If TimerEnabled = False Then
		TimerEnabled = True
		CheckTime
    End If

End Sub

Private Sub CheckTime()

    'Don't allow execution if count is less than 0
    If MyCount <= 0 Then
		TimerEnabled = False
		Exit Sub
    End If

    ' Index the timer
    If TimerEnabled = True Then
		MyCount = MyCount - 1
		Else: Exit Sub
    End If

    'Some code for user notification
    If MyCount < 180 Then
    '    If CheckNumberInput_Frm.Visible = True Then
     '       With CheckNumberInput_Frm
      '          If .TimeOut_Lbl.Visible = False Then .TimeOut_Lbl.Visible = True
       '         If .txtTimeRemaining.Visible = False Then .txtTimeRemaining.Visible = True
	'        .txtTimeRemaining.BackColor = vbWhite
	 '       .txtTimeRemaining = (Int(MyCount / 60) + 1) & " Minutes"
	  '  End With
	'End If
    End If ' my count < 180

    ' Action to be taken at time out
    If MyCount = 0 Then Sheet1.Range("A1").Value = "Timed Out"

    ' Restart the timer
    If MyCount > 0 Then
		Call timer_Start
    End If
	
End Sub

Private Sub timer_Start()
    If TimerEnabled = True Then
		Application.OnTime (Now + TimeValue("0: 0:01")), "CheckTime"
    End If
End Sub
Member Avatar for Bloodseeker
Bloodseeker 0 Newbie Poster

Try this : (You can make this as a function by setting the end time you can decide when you stop and since its a variant it has a large capacity of data.)

Dim START_TIME as variant 'Your Start Time here.
Dim END_TIME as variant 'Your end time.

END_TIME = TimeValue("12:00")
START_TIME = TimeValue("00:00")
DO While START_TIME <= END_TIME  
 START_TIME = START_TIME + TimeValue("00:01") 'its up to you on how you increment your time
loop
Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.

Edit Preview