VBA Express : Excel - A Countdown Timer

Excel

A Countdown Timer

Ease of Use

Intermediate

Version tested with

2002

Submitted by:

mgh_mgharish

Description:

This code will run a count down timer, allows user to set Total Time, Warning Time and Period of counting.

Discussion:

Suppose that you are conducting an online test which should be completed within some specified time. Then it is better to have an online timer. In that case, you can use this code to simulate a timer, which runs in the excel sheet itself

Code:

instructions for use

			Sheet1 
________ 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
Public Status As Boolean 
 
Private Sub cmdStart_Click() 
    Status = True 
    Dim WarningTime As Integer 
    Dim Period As Double 
    Dim MyTime As Double 
     
    With Sheets("Main") 
        If (.Cells(5, 1) = "") Then 
            WarningTime = .Cells(5, 4) 
        Else 
            WarningTime = .Cells(5, 1) 
        End If 
         
        If (.Cells(8, 1) = "") Then 
            Period = .Cells(8, 4) 
        Else 
            Period = .Cells(8, 1) 
        End If 
    End With 
     
    If (Period < 0.01) Then Period = 0.01 
     
    With Sheets("Counter").Cells(2, 1) 
        .FormatConditions.Delete 
        .FormatConditions.Add xlCellValue, xlLessEqual, WarningTime 
        With .FormatConditions(1).Font 
            .Bold = True 
            .ColorIndex = 3 
        End With 
        .NumberFormat = Choose(Log(Period) / Log(10) + 3, "0.00", "0.0", "0") 
         
        .Value = Sheets("Main").Cells(2, 1).Value + Period 
        Sheets("Counter").Activate 
        While (.Value > Period And Status) 
            .Value = .Value - Period 
            MyTime = .Value 
            For i = 1 To 100 * Period 
                Sleep 10 
                MyTime = MyTime - 0.01 
                If (MyTime <= 0) Then Exit For 
                DoEvents 
            Next i 
        Wend 
        If (.Value <= Period) Then .Value = "Time Up!" 
    End With 
End Sub 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    If (Target.Row = 2 And Target.Column = 1) Then 
        Cells(5, 1).Value = Cells(5, 4).Value 
    End If 
End Sub 
 
Sheet 2 
_________________ 
 
Private Sub cmdStop_Click() 
    Sheets("Counter").Cells(2, 1).FormatConditions.Delete 
    Sheets("Main").Status = False 
    Sheets("Main").Activate 
End Sub

How to use:

Rename one sheet as Main, have cells for Total Time(A2), Warning Time(A5), Default Warning Time(D5), Period(A8) and Default Period(D8).
Put "=MAX(A2/10,MIN(5,A2))" in D5 and "1" in D8.
Rename another sheet as Counter, have cells for Time Remaining(A2).
Create a command button (cmdStart) for starting the counter, in the Main sheet and another (cmdStop) for stoping the counter, in Counter sheet.
Goto Excel --> Tools --> Macro --> Visual Basic Editor (Or Press Alt + F11)
In VBE window, goto View --> Project Explorer (Or Press Ctrl + R).
Double Click the Sheet1 and paste the code shown for Sheet1 (Main).
Double Click the Sheet2 and paste the code shown for Sheet2 (Counter).

Test the code:

Change the values for Total Time, Warning Time, and Period.
Click the Start button.
To stop the counter while running, click the Stop button.

Sample File:

Counter.zip 13.9KB

Approved by mdmackillop

This entry has been viewed 364 times.