Visable Stopwatch for Road Race

[Conroy]

I have several working stopwatches but nothing I can see running. Here is what I want:

* Buttons to start, stop and reset stopwatch
* Spacebar to mark time as runners finish
* Each time distributed to the next cell beside runners name (to tenth of second) Example: Names listed in A1, A2, A3 . . . respective time recorded in B1, B2, B3 . . .

* Ability to see the running clock during the race

I know the first three are possible. What about the visiable running clock?

Thanks,
Conroy

 

[Joe Was]

I cannot get the "OnKey" to work for any keyboard key with this code?

But, I have added your H:M:S.0 format.

Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()
'Seconds and fractions of seconds Timer!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT, newTime

'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Sheet1").Range("AA1").Value
Sheets("Sheet1").Range("A1").Select

myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)

newTime = Format(myH, "0") & ":" & Format(myM, "0") & ":" & _
myS & Format(mySf, ".0000") & " H:M:S"

'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Sheet1").Range("AB1").Value = TotalTime
Sheets("Sheet1").Range("A1").Value = newTime
'Test for "ReSet!"
If ReSetSW = True Then
Sheets("Sheet1").Range("A1").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Sheet1").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = newTime
Sheets("Sheet1").Range("AA1").Value = TotalTime
SplitSW = False
GoTo myStart
End If
End
End Sub

Sub myQuit()
StopSW = True
End Sub

Sub myReSet()
Sheets("Sheet1").Range("A1").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
Range("A2:A65536").Select
Selection.ClearContents
Range("A1").Select
ReSetSW = True
SplitSW = False
End Sub

Sub mySplit()
DoEvents
SplitSW = True
End Sub

 

[Joe Was]

This is the full application code. Use the Form-Toolbar Buttons indicated above, make the buttons big. Keep columns "A & B" free. From a clean workbook copy the code below to the Sheet Module the Buttons will be on!

Could not get keybord control to work with this code though?

After you run the stopWatch code and ReSet, adjust the column widths as needed all other formatting should be automatic.


Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()
'Seconds and fractions of seconds Timer!
'Sheet Module code!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT, newTime

'Format Time cell.
Sheets("Sheet1").Range("B1").Select
With Selection
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 12
.Font.ColorIndex = xlAutomatic
End With
Sheets("Sheet1").Range("A1").Select
With Selection
.Interior.ColorIndex = 36
.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeLeft).ColorIndex = 49
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeTop).ColorIndex = 49
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeBottom).ColorIndex = 49
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlEdgeRight).ColorIndex = 49
.Font.Name = "Arial"
.Font.Size = 14
.Font.ColorIndex = xlAutomatic
.Font.Bold = True
End With
'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Sheet1").Range("AA1").Value
Sheets("Sheet1").Range("A1").Select

myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)

newTime = " " & Format(myH, "0") & ":" & Format(myM, "0") & ":" & _
myS & Format(mySf, ".0000") & " H:M:S"

'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Sheet1").Range("AB1").Value = TotalTime
Sheets("Sheet1").Range("A1").Value = newTime
'Test for "ReSet!"
If ReSetSW = True Then
Sheets("Sheet1").Range("B1").Value = " <== Total Time"
Sheets("Sheet1").Range("A1").Value = " 0:00:00.0 H:M:S"
Sheets("Sheet1").Range("AA1").Value = 0
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Sheet1").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Select
With Selection
.Value = " " & newTime
.Interior.ColorIndex = 35
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeLeft).ColorIndex = 51
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = 51
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).ColorIndex = 51
End With
Selection.Offset(0, 1).Value = " <== Split # : " & Selection.Offset(0, 1).Row - 1
Sheets("Sheet1").Range("AA1").Value = TotalTime
Sheets("Sheet1").Range("A1").Select
SplitSW = False
GoTo myStart
End If
End
End Sub

Sub myQuit()
StopSW = True
End Sub

Sub myReSet()
Sheets("Sheet1").Range("A1").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
Range("A2:B65536").Select
With Selection
.ClearContents
.Interior.ColorIndex = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
End With
Sheets("Sheet1").Range("B1").Value = " <== Total Time"
Sheets("Sheet1").Range("A1").Select
Selection.Value = " 0:00:00.0 H:M:S"
ReSetSW = True
SplitSW = False
End Sub

Sub mySplit()
DoEvents
SplitSW = True
End Sub

 

[Conroy]

I love the new code. Thanks again. The only trouble I have encountered is with the mouse speed. If I click too fast, it doesn't pick up times. Changing the mouse speed got me from .4 to .2 seconds, but I can still click too fast. If the person timing is disciplined, he can pace his clicks to not be too fast but that is obviously not ideal. I keep thinking that the "Onkey" is the solution, but that may be a modification for later. Thanks again for everyone's help.

Conroy

 

[PA HS Teacher]

Hey guys,
First of all, cool stopwatch. I've thought about something like this for awhile, but never thought of an easy way to do it. Your code is great. I did, however make a few modifications. (basically formatting)

1. I formatted the time so that it displays as h:mm:ss.00, I did this
for the sheet and in the code.
e.g. 1:03:04.56 instead of 1:3:4.5643

2. I added a "Lap" column in C
(the difference between adjacent times)
e.g. If A2 = 0:01:12.56 and A3 = 2:12.56
C3 = 0:01:00.00

This fomatting allows me to manipulate the number later. For example I can use the Average function to Average splits. I can sort the times or filter out all times between a certain criteria.

I don't see any easy way to make the sheet respond faster (that is record more than 2 times in 1 sec.) If I was to use this in practice, say at a road race, I would have the traditional hand timer as back up, and fill in the missing times on the spreadsheet after the race.

I tried to highlight my changes below, but I may have missed a few.
(I also had to take out the " " in one or two places.)

Hope this is a useful modification for someone.

~ Dan

Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()
'Seconds and fractions of seconds Timer!
'Sheet Module code!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT
Dim newtime

'Format Time cell.
Sheets("Sheet1").Range("B1").Select
With Selection
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 12
.Font.ColorIndex = xlAutomatic
End With
Sheets("Sheet1").Range("A1").Select
With Selection
.Interior.ColorIndex = 36
.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeLeft).ColorIndex = 49
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeTop).ColorIndex = 49
.Borders(xlEdgeBottom).Weight = xlThick
.Borders(xlEdgeBottom).ColorIndex = 49
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlEdgeRight).ColorIndex = 49
.Font.Name = "Arial"
.Font.Size = 14
.Font.ColorIndex = xlAutomatic
.Font.Bold = True
End With
'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Sheet1").Range("AA1").Value
Sheets("Sheet1").Range("A1").Select

myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)

newtime = Format(Format(myH, "0") & ":" & Format(myM, "00") & ":" & _
Format(myS, "00") & Format(mySf, ".00"), "h:mm:ss.00") ' & " H:M:S"[/b]
'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Sheet1").Range("AB1").Value = Format(TotalTime, "h:mm:ss.00")
Sheets("Sheet1").Range("A1").Value = Format(newtime, "h:mm:ss.00")
'Test for "ReSet!"
If ReSetSW = True Then
Sheets("Sheet1").Range("B1").Value = " <== Total Time"
Sheets("Sheet1").Range("A1").Value = Format(" 0:00:00.0", "h:mm:ss.00")
Sheets("Sheet1").Range("AA1").Value = Format(0, "h:mm:ss.00")
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Sheet1").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Select
With Selection
.Value = newtime
.Interior.ColorIndex = 35
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeLeft).ColorIndex = 51
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).ColorIndex = 51
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).ColorIndex = 51
End With
Selection.Offset(0, 1).Value = " <== Split # : " & Selection.Offset(0, 1).Row - 1
Selection.Offset(0, 2).Value = Selection.Offset(0, 0).Value - Selection.Offset(-1, 0).Value
Sheets("Sheet1").Range("AA1").Value = TotalTime
Sheets("Sheet1").Range("A1").Select
SplitSW = False
GoTo myStart
End If
End
End Sub

Sub myQuit()
StopSW = True
End Sub

Sub myReSet()
Sheets("Sheet1").Range("A1").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
Range("A2:C65536").Select
With Selection
.ClearContents
.Interior.ColorIndex = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
End With
Sheets("Sheet1").Range("B1").Value = " <== Total Time"
Sheets("Sheet1").Range("A1").Select
Selection.Value = Format(" 0:00:00.0", "h:mm:ss.00")ReSetSW = True
SplitSW = False
End Sub

Sub mySplit()
DoEvents
SplitSW = True
End Sub

 

[mahmed1]

Hi Guys,

Where is the Split button in excel 2007?

 

[Joe Was]

Hi Guys,

Where is the Split button in excel 2007?

On-Sheet Form buttons have been removed from Excel 2007, use Shape Buttons in place of them, I like the Bevel-Shape for buttons!

 

[Mike1987]

Hello all, this is my first post on this forum. I am hoping to get some guidance on how I can use this stop watch with other animated macros working at the same time. I want the 2 animation strings to start when I use the start button for the stop watch. This is what I have so far;

Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()
'Seconds and fractions of seconds Timer!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT, newTime
'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Sheet1").Range("AA1").Value
Sheets("Sheet1").Range("i8").Select
myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)
newTime = Format(myH, "0") & " :" & Format(myM, "0") & " :" & _
myS & " H:M:S"
'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Sheet1").Range("AB1").Value = TotalTime
Sheets("Sheet1").Range("i8").Value = newTime
'Test for "ReSet!"
If ReSetSW = True Then
Sheets("Sheet1").Range("i8").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Sheet1").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = newTime
Sheets("Sheet1").Range("AA1").Value = TotalTime
SplitSW = False
GoTo myStart
End If
End
End Sub
Sub myQuit()
StopSW = True
End Sub

Sub myReSet()
Sheets("Sheet1").Range("i8").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
Range("A2:A65536").Select
Selection.ClearContents
Range("i8").Select
ReSetSW = True
SplitSW = False
End Sub
Sub mySplit()
DoEvents
SplitSW = True
End Sub
Sub Animate_String()
Dim sTxt As String
Dim x As Integer, y As Integer
Dim Start, delay
sTxt = "Time Is Money!!"
For y = 1 To 15 '15 Loops through the scrolling
For x = 1 To 26 'Index number of times
Start = Timer 'Set start to internal timer
delay = Start + 0.15 'Set delay for .15 secs
Do While Timer < delay 'Do the display routine
[h2] = Space(x) & sTxt 'Show 1 str @ a time
DoEvents 'do there things
Loop 'Loop until delay is up
DoEvents
Start = Timer 'and reset the timer
delay = Start + 0.15 'and the delay
Next x 'Show the next str
Next y 'Do this again - 15
[D6] = "" 'Reset
End Sub

Sub Animate_String2()
Dim sTxt As String
Dim x As Integer, y As Integer
Dim Start, delay
sTxt = "£ £ £ £ £ £"
For y = 1 To 15 '15 Loops through the scrolling
For x = 1 To 18 'Index number of times
Start = Timer 'Set start to internal timer
delay = Start + 0.15 'Set delay for .15 secs
Do While Timer < delay 'Do the display routine
[f36] = Space(x) & sTxt 'Show 1 str @ a time
DoEvents 'do there things
Loop 'Loop until delay is up
DoEvents
Start = Timer 'and reset the timer
delay = Start + 0.15 'and the delay
Next x 'Show the next str
Next y 'Do this again - 15
[D6] = "" 'Reset
End Sub


I tryed using the call function but either couldn't get this to work or I got it to work as a separate module but called each macro in order (as expected) instead of at the same time.

I am very new to VBA as you can probably tell by way of me needing to pull lots of other peoples codes to make what I need so anyone that can step me through how to get this working I would greatly apreciate it.

Thank you very much