Count down

E

EW

All-
Is there a way to show in a cell in a rolling countdown. For example I
would like the timer to start at 30 mins (30:00) and countdown to 0. I would
like to take a current cell that contains a =now() formula and replace it
with this, but the catch would be it needs to intigrate with the on-time
method so that between the on-time method running the procedure it would
count down from 30-0 min. Is there anything out there like this?

Thanks in advance!
 
M

macropod

Hi EW,

In a new Workbook:

1. put the following subs in the 'ThisWorkbook' module-
Private Sub Workbook_Open()
BkNm = ThisWorkbook.Name
'Call StartClock
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call StopClock
Workbooks(BkNm).Saved = True
End Sub
If you want the timer to run automatically whenever the workbook opens,
uncoment the "Call StartClock" line

2. put the following subs in a standard module-
Option Explicit
Dim NextTick
Public BkNm
Sub StartClock()
UpdateClock
End Sub

Private Sub UpdateClock()
With Windows(BkNm)
NextTick = Now + TimeValue("00:00:01")
With Workbooks(BkNm).Sheets("Clock")
Range("A1").Activate
Application.OnTime NextTick, "UpdateClock"
If Int((Range("A1").Value) - Now) = 0 Then
Range("D6").Value = Format((Range("A1").Value - Now),
"hh:mm:ss")
Else
Range("D6").Value = Int((Range("A1").Value) - Now) & " " & _
Format((Range("A1").Value - Now), "hh:mm:ss")
End If
Range("D6").Columns.ColumnWidth = _
Application.WorksheetFunction.Max(Int(Len(Trim(Range("D4").Text)) *
2.5), _
Int(Len(Trim(Range("D6").Text)) * 5))
End With
End With
End Sub

Sub StopClock()
On Error Resume Next
Application.OnTime NextTick, "UpdateClock", , False
End Sub

Put the ending date & time into cell A1 (you may want to add a sub with an
InputBox for this).

As coded, the "UpdateClock" clock sub outputs in Cell D6, and formats that
cell to a width suitable for 48pt Arial. Makes it nice and large. You might
want to do something different. The wrapped line starting with
"Range("D6").Columns.ColumnWidth =" sets the cell D6 formatting.

Cheers
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top