Stopwatch macro

[wil]

Anyone have a stopwatch macro. I would like to present a countdown timer using excel. Want to put in a variable number of minutes or seconds and count down to zero.

Thanks

 

[VoG]

This (Count_Down_Timer) counts down 60 secs to 0 in A1. It also puts a message in B1. Adapt to suit.

Option Explicit
Option Base 1

Dim AlarmTime As Date, AlarmTime2 As Date
Sub Count_Down_Timer()
ActiveSheet.Range("A1").Value = 60
ActiveSheet.Range("B1").Value = "Counting"
Call TrapTime
Call TrapTime2
End Sub
Private Sub ShowTimeLeft()
ActiveSheet.Range("A1").Value = Second(AlarmTime - Now)
Call TrapTime2
End Sub
Private Sub TrapTime()
AlarmTime = CDate(Date) + TimeValue(Now()) + TimeValue("00:01:00")
Application.OnTime earliesttime:=AlarmTime, procedure:="StopTimer"
End Sub
Private Sub TrapTime2()
AlarmTime2 = CDate(Date) + TimeValue(Now()) + TimeValue("00:00:01")
Application.OnTime earliesttime:=AlarmTime2, procedure:="ShowTimeLeft"
End Sub
Private Sub StopTimer()
On Error Resume Next
Application.OnTime earliesttime:=AlarmTime2, procedure:="showtimeleft", schedule:=False
On Error GoTo 0
ActiveSheet.Range("B1").Value = "Done"
End Sub

 

[Paul B]

This will let you input a time and will pop up a message box when the time is up

Sub CountDownTimer()
Dim beepat As String
beepat = InputBox("Count down Timer HH:MM:SS i.e. 00:10:00 Is Ten Minutes", _
"Time now is " & Format(Now, "hh:mm:ss"), "00:10:00")
If beepat = "" Then
MsgBox "Cancelled"
Exit Sub
End If
Application.OnTime (Now + TimeValue(beepat)), "Time"
End Sub

Private Sub time()
MsgBox "Time Is Up!", , "Reminder"
End Sub

 

[Sinnistar]

I modified Vog's code a bit to make a working stop watch. Open a NEW Excel workbook, open vb editor, add a module, paste in code. Run the initialize method and that is all. Sets up buttons for starting/stopping stopwatch. Enter the time you want to countdown in minutes/seconds.

Dim alarm As Date
Dim start As Date
Dim sec As Integer
Dim min As Integer

Sub initialize()
' set default values
    Range("B1:B2").MergeCells = True
    Range("C1:C2").MergeCells = True
    Range("B1:C2").Select
    
    With Selection
        'FormatConditions
        .FormatConditions.Delete
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$B$1+$C$1>0"
        .FormatConditions(1).Interior.ColorIndex = 4
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$B$1+$C$1<=0"
        .FormatConditions(2).Interior.ColorIndex = 3
        
        ' Borders
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        
        ' Text Alignment
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        
        ' Font
        .Font.Name = "Calibri"
        .Font.Size = 24
    End With
    
    Rows("1:2").RowHeight = 20
    
    'Add Start Button
    ActiveSheet.Range("A1").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .ShapeRange.Fill.ForeColor.SchemeColor = 43
        .Characters.Text = "Start"
        .OnAction = "StartTimer"
        .Font.Name = "Calibri"
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    'Add Stop Button
    ActiveSheet.Range("A2").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .ShapeRange.Fill.ForeColor.SchemeColor = 42
        .Characters.Text = "Stop"
        .OnAction = "StopTimer"
        .Font.Name = "Calibri"
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
  '
    ActiveSheet.Range("B1").Value = 0
    ActiveSheet.Range("C1").Value = 5
    
    Call StartTimer
    
End Sub

Sub StartTimer()
'start timer, set values according to value on sheet

    sec = ActiveSheet.Range("C1").Value
    min = ActiveSheet.Range("B1").Value
    ActiveSheet.Range("A2").Select
    start = TimeValue(Now())
    Call TrapTime
    
End Sub
Private Sub UpdateDisplay()
' updates display

    ActiveSheet.Range("C1").Value = sec - Second(Now - start)
    ActiveSheet.Range("B1").Value = min - Minute(Now - start)
    If ActiveSheet.Range("C1").Value < 0 Then
        ActiveSheet.Range("B1").Value = ActiveSheet.Range("B1").Value - 1
        ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value + 60
    End If
    
    Call TrapTime
    
End Sub
Private Sub TrapTime()

    If ActiveSheet.Range("B1").Value <= 0 And ActiveSheet.Range("C1").Value <= 0 Then
        StopTimer
        Exit Sub
    End If
    
    alarm = CDate(Date) + TimeValue(Now()) + TimeValue("00:00:01")
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay"
    
End Sub
Sub StopTimer()

    On Error Resume Next
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay", schedule:=False
    
End Sub

 

[paul-aug]

I just had to sign up just to thank you for your brialliant count down timer.

 

[Biz]

I modified Vog's code a bit to make a working stop watch. Open a NEW Excel workbook, open vb editor, add a module, paste in code. Run the initialize method and that is all. Sets up buttons for starting/stopping stopwatch. Enter the time you want to countdown in minutes/seconds.

Dim alarm As Date
Dim start As Date
Dim sec As Integer
Dim min As Integer
 
Sub initialize()
' set default values
    Range("B1:B2").MergeCells = True
    Range("C1:C2").MergeCells = True
    Range("B1:C2").Select
 
    With Selection
        'FormatConditions
        .FormatConditions.Delete
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$B$1+$C$1>0"
        .FormatConditions(1).Interior.ColorIndex = 4
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$B$1+$C$1<=0"
        .FormatConditions(2).Interior.ColorIndex = 3
 
        ' Borders
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
 
        ' Text Alignment
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
 
        ' Font
        .Font.Name = "Calibri"
        .Font.Size = 24
    End With
 
    Rows("1:2").RowHeight = 20
 
    'Add Start Button
    ActiveSheet.Range("A1").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .ShapeRange.Fill.ForeColor.SchemeColor = 43
        .Characters.Text = "Start"
        .OnAction = "StartTimer"
        .Font.Name = "Calibri"
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
 
    'Add Stop Button
    ActiveSheet.Range("A2").Select
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
    With Selection
        .ShapeRange.Fill.ForeColor.SchemeColor = 42
        .Characters.Text = "Stop"
        .OnAction = "StopTimer"
        .Font.Name = "Calibri"
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
  '
    ActiveSheet.Range("B1").Value = 0
    ActiveSheet.Range("C1").Value = 5
 
    Call StartTimer
 
End Sub
 
Sub StartTimer()
'start timer, set values according to value on sheet
 
    sec = ActiveSheet.Range("C1").Value
    min = ActiveSheet.Range("B1").Value
    ActiveSheet.Range("A2").Select
    start = TimeValue(Now())
    Call TrapTime
 
End Sub
Private Sub UpdateDisplay()
' updates display
 
    ActiveSheet.Range("C1").Value = sec - Second(Now - start)
    ActiveSheet.Range("B1").Value = min - Minute(Now - start)
    If ActiveSheet.Range("C1").Value < 0 Then
        ActiveSheet.Range("B1").Value = ActiveSheet.Range("B1").Value - 1
        ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value + 60
    End If
 
    Call TrapTime
 
End Sub
Private Sub TrapTime()
 
    If ActiveSheet.Range("B1").Value <= 0 And ActiveSheet.Range("C1").Value <= 0 Then
        StopTimer
        Exit Sub
    End If
 
    alarm = CDate(Date) + TimeValue(Now()) + TimeValue("00:00:01")
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay"
 
End Sub
Sub StopTimer()
 
    On Error Resume Next
    Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay", schedule:=False
 
End Sub

Nice Vba m8.

Biz

 

[paul-aug]

Hello again,
Thanks again Sinnistar for countdown timer.
I put it on my sheet and it worked fine, however there is alot of stuff on my
sheet and only on a notebook so I was getting loads of Screen Flicker.

I looked at the time as just counting down numbers and changed the code as
follows. Now Screen Flicker is cured.

I'm new to vba so I'm sure ye experts will find this not good practice.

CODECODECODECODECODECODECODECODECODECODECODECODECODECODE

Dim alarm As Date


Sub initialize()
' set default values
Range("B1:B2").MergeCells = True
Range("C1:C2").MergeCells = True
Range("B1:C2").Select

With Selection
'FormatConditions
.FormatConditions.Delete
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=$B$1+$C$1>0"
.FormatConditions(1).Interior.ColorIndex = 4
.FormatConditions.Add Type:=xlExpression, Formula1:="=$B$1+$C$1<=0"
.FormatConditions(2).Interior.ColorIndex = 3

' Borders
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous

' Text Alignment
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter

' Font
.Font.Name = "Calibri"
.Font.Size = 24
End With

Rows("1:2").RowHeight = 20

'Add Start Button
ActiveSheet.Range("A1").Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 43
.Characters.Text = "Start"
.OnAction = "StartTimer"
.Font.Name = "Calibri"
.Font.Size = 14
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

'Add Stop Button
ActiveSheet.Range("A2").Select
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height).Select
With Selection
.ShapeRange.Fill.ForeColor.SchemeColor = 42
.Characters.Text = "Stop"
.OnAction = "StopTimer"
.Font.Name = "Calibri"
.Font.Size = 14
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
'
ActiveSheet.Range("B1").Value = 0
ActiveSheet.Range("C1").Value = 5

Call StartTimer

End Sub

Sub StartTimer()
'start timer, set values according to value on sheet
'
'
'


Call TrapTime

End Sub
Private Sub UpdateDisplay()
' updates display

ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value - 1

If ActiveSheet.Range("C1").Value < 0 Then
ActiveSheet.Range("B1").Value = ActiveSheet.Range("B1").Value - 1
ActiveSheet.Range("C1").Value = ActiveSheet.Range("C1").Value + 60
End If

Call TrapTime

End Sub
Private Sub TrapTime()

If ActiveSheet.Range("B1").Value <= 0 And ActiveSheet.Range("C1").Value <= 0 Then
StopTimer
Exit Sub
End If

alarm = CDate(Date) + TimeValue(Now()) + TimeValue("00:00:01")
Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay"

End Sub
Sub StopTimer()

On Error Resume Next
Application.OnTime earliesttime:=alarm, procedure:="UpdateDisplay", schedule:=False

End Sub

 

[desert_dweller5]

This macro is cool. Is it possible to have this macro adapt so that it can count up from a date and time. like for example to know exactly how old a person or an event is? I've been searching the web and can't find what i'm looking for. I was hoping that this code could be adapted to do something like that and have it do it for multiple dates/times in a column. I have certain dates of things I have to keep and I'd like to know how old they are to the second and also a count down till 5 years from when they happened so I can stop reporting them when that timer reaches zero. I've tried some of the solutions from the web, but none seem to update automatically. What I'd like is:
A B C
Date and time of event time since event time till stop report for<...>
mm/dd/yyyy ab:cd YY:MM:DD:HH:MM:SS YY:MM:DD:HH:MM:SS
^Counts up ^counts down

D
Specified date for <...>


the point is i want to have the power to have timers for mutiple organizations when they stop requiring me to report an event to them and when it will cease to be on their records, because of organizations purging their records every 5 7 10 years or whenever they are required to do so.

this might be useful for businesses who have to keep track of when they have to purge certain records. and have different time tables for different vendors or clients.

I hope this can be done. I'm a beginner - a noob. This is way over my head. that why I need help. thanks for your help in advance.
Sincerely,
Desert_dweller5

 

[desert_dweller5]

This macro is cool. Is it possible to have this macro adapt so that it can count up from a date and time. like for example to know exactly how old a person or an event is? I've been searching the web and can't find what i'm looking for. I was hoping that this code could be adapted to do something like that and have it do it for multiple dates/times in a column. I have certain dates of things I have to keep and I'd like to know how old they are to the second and also a count down till 5 years from when they happened so I can stop reporting them when that timer reaches zero. I've tried some of the solutions from the web, but none seem to update automatically. What I'd like is:
A B C
Date and time of event time since event time till stop report for<...>
mm/dd/yyyy ab:cd YY:MM:DD:HH:MM:SS YY:MM:DD:HH:MM:SS
^Counts up ^counts down

Description of above "chart"

I'd like in column a the date and time of the event in the MM/DD/YYYY format with the time in AB:CD AM/PM format. In column B I'd like a timer that counts up from the event and it should be formatted as YYYY:MM:DD:HH:MM:SS as duration. Seconds 0 to 59 then minutes 0 to 59 hours 0-23 on 24 rolls over to next day. Days coordinate with the calendar, this program shouldn't average to 30 day months it will respect the Gregorian calendar with leap years accounted for. For example the timer would count down to the next month as follows: when the system clock = 1/31/12 11:59:59 the next second the program will increment the month by 1. also same would happen on 2/29/2012 11:59:59+1 second. None of the dates are before 1900. though if you want to challenge yourselves please feel free to go back to the beginning of the gregorian calendar in the USA so we can keep track of our ancestors birthdays and aniversary of deaths.

Count down would work in the same fashion but in the opposite direction. respecting leap years and only decrements the month according to the Gregorian calendar keeping in mind of how many days that individual month has.

<http://www.timeanddate.com/date/timeduration.html?m1=&d1=&y1=&m2=&d2=&y2=>

there is a Duration calculator online at timeanddate.com and it will calculate for you, that's the inspiration. it just doesn't let me do batch dates or timers or count downs. It may let you but it's not neat, you have to go to several different web pages to get the info needed. it's very inefficient. That's where excel comes in.

I want to have the power to have timers for mutiple organizations when they stop requiring me to report an event to them and when it will cease to be on their records, because of organizations purging their records every 5 7 10 years or whenever they are required to do so.

this might be useful for businesses who have to keep track of when they have to purge certain records. and have different time tables for different vendors or clients.

I hope this can be done. I'm a beginner - a noob. This is way over my head. that's why I need help. thanks for your help in advance.
Sincerely,
Desert_dweller5

 

[paul-aug]

Hello,

Wow, that sounds like a lot of timers, code and time. I'm new to the game and only part time so take my advise with a pinch of salt.

If I were trying to do so many timers, what I would do is put all your different formula in all the different cells you want and refer back to any chosen cell which has the "=Now" function in the formula.
This chosen cell will return the current time and therefore you can + and - from this time in as many other cells you need.
Then I would write a small bit of code that Recalculates the page (say every second). Assign this macro to a start button and I would think it would be a good idea to have a stop button also.

Someone with brains out there might think this is an awfull idea.

Have fun.