Excel StopWatch

R

roy.furman

hello,
i am new to programing in excel
i need to creat a boton that i can place in every cell that i want.
clicing the first time shuld atsrt the timmer and clicing it again will
stop.
after stoping the timmer the result should display in seconds in the
next cell

thank you
roy
 
D

Dave Peterson

I used 3 adjacent cells to keep track of the start, stop and net times.

The first routine plops in the buttons from the Forms toolbar in a selected
range.

The second routine does the work when you click on a button.

Option Explicit
Sub RunOnce()

Dim myCell As Range
Dim myRng As Range
Dim BTN As Button

With ActiveSheet
Set myRng = .Range("a1:A10")
End With

For Each myCell In myRng.Cells
With myCell
Set BTN = .Parent.Buttons.Add(Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With

With BTN
.OnAction = "'" & ThisWorkbook.Name & "'!" & "StartStop"
.Caption = "Start"
End With
Next myCell

End Sub
Sub StartStop()

Dim BTN As Button
Dim myOffset As Long
Dim NewCaption As String

Set BTN = ActiveSheet.Buttons(Application.Caller)

If LCase(BTN.Caption) = "start" Then
myOffset = 1
NewCaption = "Stop"
BTN.TopLeftCell.Offset(0, 1).Resize(1, 3).ClearContents
Else
myOffset = 2
NewCaption = "Start"
End If

With BTN.TopLeftCell.Offset(0, myOffset)
.Value = Time
.NumberFormat = "hh:mm:ss"
End With

BTN.Caption = NewCaption

If LCase(BTN.Caption) = "start" Then
With BTN.TopLeftCell.Offset(0, 3)
.FormulaR1C1 = "=rc[-1]-rc[-2]"
.NumberFormat = "hh:mm:ss"
End With
End If

End Sub
 
G

Guest

Dave,

This routine works great! Would you mind modifiying it so that every time
you click start and stop on a row it adds the results to the net time? I
know nothing about VBA so I rely on you gurus!!

Thanks!

Randy

Dave Peterson said:
I used 3 adjacent cells to keep track of the start, stop and net times.

The first routine plops in the buttons from the Forms toolbar in a selected
range.

The second routine does the work when you click on a button.

Option Explicit
Sub RunOnce()

Dim myCell As Range
Dim myRng As Range
Dim BTN As Button

With ActiveSheet
Set myRng = .Range("a1:A10")
End With

For Each myCell In myRng.Cells
With myCell
Set BTN = .Parent.Buttons.Add(Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With

With BTN
.OnAction = "'" & ThisWorkbook.Name & "'!" & "StartStop"
.Caption = "Start"
End With
Next myCell

End Sub
Sub StartStop()

Dim BTN As Button
Dim myOffset As Long
Dim NewCaption As String

Set BTN = ActiveSheet.Buttons(Application.Caller)

If LCase(BTN.Caption) = "start" Then
myOffset = 1
NewCaption = "Stop"
BTN.TopLeftCell.Offset(0, 1).Resize(1, 3).ClearContents
Else
myOffset = 2
NewCaption = "Start"
End If

With BTN.TopLeftCell.Offset(0, myOffset)
.Value = Time
.NumberFormat = "hh:mm:ss"
End With

BTN.Caption = NewCaption

If LCase(BTN.Caption) = "start" Then
With BTN.TopLeftCell.Offset(0, 3)
.FormulaR1C1 = "=rc[-1]-rc[-2]"
.NumberFormat = "hh:mm:ss"
End With
End If

End Sub


hello,
i am new to programing in excel
i need to creat a boton that i can place in every cell that i want.
clicing the first time shuld atsrt the timmer and clicing it again will
stop.
after stoping the timmer the result should display in seconds in the
next cell

thank you
roy
 
D

Dave Peterson

Change that last portion of the second routine:

If LCase(BTN.Caption) = "start" Then
With BTN.TopLeftCell.Offset(0, 3)
.FormulaR1C1 = "=rc[-1]-rc[-2]"
.NumberFormat = "hh:mm:ss"
End With
With BTN.TopLeftCell.Offset(0, 4)
.Value = .Value + .Offset(0, -1).Value
.NumberFormat = "hh:mm:ss"
End With
End If

It just uses column E to get the total net time.
Dave,

This routine works great! Would you mind modifiying it so that every time
you click start and stop on a row it adds the results to the net time? I
know nothing about VBA so I rely on you gurus!!

Thanks!

Randy

Dave Peterson said:
I used 3 adjacent cells to keep track of the start, stop and net times.

The first routine plops in the buttons from the Forms toolbar in a selected
range.

The second routine does the work when you click on a button.

Option Explicit
Sub RunOnce()

Dim myCell As Range
Dim myRng As Range
Dim BTN As Button

With ActiveSheet
Set myRng = .Range("a1:A10")
End With

For Each myCell In myRng.Cells
With myCell
Set BTN = .Parent.Buttons.Add(Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With

With BTN
.OnAction = "'" & ThisWorkbook.Name & "'!" & "StartStop"
.Caption = "Start"
End With
Next myCell

End Sub
Sub StartStop()

Dim BTN As Button
Dim myOffset As Long
Dim NewCaption As String

Set BTN = ActiveSheet.Buttons(Application.Caller)

If LCase(BTN.Caption) = "start" Then
myOffset = 1
NewCaption = "Stop"
BTN.TopLeftCell.Offset(0, 1).Resize(1, 3).ClearContents
Else
myOffset = 2
NewCaption = "Start"
End If

With BTN.TopLeftCell.Offset(0, myOffset)
.Value = Time
.NumberFormat = "hh:mm:ss"
End With

BTN.Caption = NewCaption

If LCase(BTN.Caption) = "start" Then
With BTN.TopLeftCell.Offset(0, 3)
.FormulaR1C1 = "=rc[-1]-rc[-2]"
.NumberFormat = "hh:mm:ss"
End With
End If

End Sub


hello,
i am new to programing in excel
i need to creat a boton that i can place in every cell that i want.
clicing the first time shuld atsrt the timmer and clicing it again will
stop.
after stoping the timmer the result should display in seconds in the
next cell

thank you
roy
 
G

Guest

Thanks Dave, that worked great!

Dave Peterson said:
Change that last portion of the second routine:

If LCase(BTN.Caption) = "start" Then
With BTN.TopLeftCell.Offset(0, 3)
.FormulaR1C1 = "=rc[-1]-rc[-2]"
.NumberFormat = "hh:mm:ss"
End With
With BTN.TopLeftCell.Offset(0, 4)
.Value = .Value + .Offset(0, -1).Value
.NumberFormat = "hh:mm:ss"
End With
End If

It just uses column E to get the total net time.
Dave,

This routine works great! Would you mind modifiying it so that every time
you click start and stop on a row it adds the results to the net time? I
know nothing about VBA so I rely on you gurus!!

Thanks!

Randy

Dave Peterson said:
I used 3 adjacent cells to keep track of the start, stop and net times.

The first routine plops in the buttons from the Forms toolbar in a selected
range.

The second routine does the work when you click on a button.

Option Explicit
Sub RunOnce()

Dim myCell As Range
Dim myRng As Range
Dim BTN As Button

With ActiveSheet
Set myRng = .Range("a1:A10")
End With

For Each myCell In myRng.Cells
With myCell
Set BTN = .Parent.Buttons.Add(Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With

With BTN
.OnAction = "'" & ThisWorkbook.Name & "'!" & "StartStop"
.Caption = "Start"
End With
Next myCell

End Sub
Sub StartStop()

Dim BTN As Button
Dim myOffset As Long
Dim NewCaption As String

Set BTN = ActiveSheet.Buttons(Application.Caller)

If LCase(BTN.Caption) = "start" Then
myOffset = 1
NewCaption = "Stop"
BTN.TopLeftCell.Offset(0, 1).Resize(1, 3).ClearContents
Else
myOffset = 2
NewCaption = "Start"
End If

With BTN.TopLeftCell.Offset(0, myOffset)
.Value = Time
.NumberFormat = "hh:mm:ss"
End With

BTN.Caption = NewCaption

If LCase(BTN.Caption) = "start" Then
With BTN.TopLeftCell.Offset(0, 3)
.FormulaR1C1 = "=rc[-1]-rc[-2]"
.NumberFormat = "hh:mm:ss"
End With
End If

End Sub


(e-mail address removed) wrote:

hello,
i am new to programing in excel
i need to creat a boton that i can place in every cell that i want.
clicing the first time shuld atsrt the timmer and clicing it again will
stop.
after stoping the timmer the result should display in seconds in the
next cell

thank you
roy
 
I

isaac.gandalf

Hi Dave! This was really useful!
I have 2 questions if I may:

1.) How do you do it so that instead of appearing on the right of the button, the data (start time, end time, difference) appears directly below the button?

2.) Instead of clearing the cells, how do you make it place the data (start time, end time, difference) directly below the cell above it? That way, we'll have a list of the start, end and difference times?

Thanks,
Isaac
 

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