Additional function to copy a time to new cell

[kevgisme]

Hi All,

Hope someone out there can help me with this one.

I currently have code which will start a timer in columns B & C when I double click on any populated cell in column A. The timer starts in the corresponding row and I have other calculations running from the timers.
If I stop a timer, and then restart it again, it picks up where it was and adds time cumulatively. This is what I wanted the code to do primarily, but I now would also like to know how long each recorded time was, not just the cumulative time.

Does anyone know a way of adding in some code which will watch the cell and copy the contents of the timer to a new column every time it stops?
Im not sure if this is possible or not, I have attached the code I have been using below, which is stored in sheet1.


Public stopMe As Boolean
Public resetMe As Boolean
Public myVal As Variant
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then

If Target.Value = myVal And Target.Value <> "" Then
'Changed
Dim startTime, finishTime, totalTime, timeRow
startTime = Timer
stopMe = False
resetMe = False
myTime = Target.Offset(, 2).Value
Target.Offset(, 1).Select
startMe:
DoEvents
timeRow = Target.Row
finishTime = Timer
totalTime = finishTime - startTime
Target.Offset(, 1).Value = Format(myTime + totalTime, "0.0000") & " Seconds"
If resetMe = True Then
Target.Offset(, 1).Value = 0
Target.Offset(, 2).Value = 0
stopMe = True
End If
If Not stopMe = True Then
Target.Offset(, 2).Value = Format(myTime + totalTime, "0.0000")
GoTo startMe
End If
Cancel = True
End
Else
'Not Changed
stopMe = True
Cancel = True


'Added
If Target.Row = 3 And Target.Column = 1 Then


Range("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AT1").Value = Now
Range("AT2").Value = Range("C1").Value
Else
End If
'End Added

End If
End If


End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
myVal = Target.Value
End Sub




Thanks in advance,
Kevin