Check code

[drum118]

Can some try to see where the error is for this code as it will not work
in the new book like the old one.

Using =RunTime(XXXX) in the cells to obtain the time it took from one
point to another point. Want to get the time down to minutes and seconds

Also using this code too.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim TimeStr As String

On Error GoTo EndMacro
If Application.Intersect(Target,
Range("MyTimeCols,MyTimeCols2,MyTimeCols3,MyTimeCols4,")) Is Nothing
Then
Exit Sub

I am getting #name? in cells that should display 00:07:30, 00:09:55,
00:55:55 etc.


++++++++++++++++++++++++++++++++++++++++
Function RunTime(EndTime As Range) As Double
Dim StartTime As Double
Dim org As Range
Dim STstr As String, ETstr As String
Dim stH As Long, stMIN As Long, stSEC As Long
Dim etH As Long, etMIN As Long, etSEC As Long
Dim col As Long, EndCol As Long, rw As Long
Dim i As Long
Const startCol = 15 'Column O
Const LabelRow = 5
Dim temp As Double

Dim ar
Const c1 = "Bus Departs at", c2 = "Stop #" 'this defines the Start
Time

ar = Array(c1, c2)

EndCol = EndTime.Column - 1
rw = EndTime.Row

If EndTime.Value = 0 Then
RunTime = 0
Exit Function
End If

If Not IsNumeric(EndTime.Value) Then Exit Function

If EndTime = 0 Then
RunTime = 0
Exit Function
End If

StartTime = 0
For col = startCol To EndCol
If InStr(1, Cells(LabelRow, col), c1) + _
InStr(1, Cells(LabelRow, col), c2) > 0 Then
StartTime = Cells(rw, col).Value
End If
If StartTime > 0 Then Exit For
Next col

If StartTime = 0 Then
RunTime = 0
Exit Function
End If


STstr = Format(StartTime, "00:00:00")
ETstr = Format(EndTime, "00:00:00")

stH = Left(STstr, 2)
stMIN = Mid(STstr, 3, 2)
stSEC = Right(STstr, 2)

etH = Left(ETstr, 2)
etMIN = Mid(ETstr, 3, 2)
etSEC = Right(ETstr, 2)

temp = TimeSerial(etH, etMIN, etSEC) - TimeSerial(stH, stMIN, stSEC)

RunTime = CDbl(Format(temp, "hh:mm:ss"))



End Function

 

[Tushar Mehta]

First of all, the Worksheet_Change routine should fault at runtime when
trying to execute
Range("MyTimeCols,MyTimeCols2,MyTimeCols3,MyTimeCols4,") The last
comma will mess things up.

As far as the function goes, I don't know why it isn't working. My
guess is that it is related to the cell in which the function is
entered. So, what cell are you entering it in?

In general it is a very bad idea to have a function access cells behind
XL's back, as it were. I'm referring to the search for the StartTime
value.

Also, from what I can tell, the gyrations after the starttime is
identified in computing the runtime are quite unnecessary.

The code below compiles OK but has not been otherwise tested.

Function RunTime(StartTimeRng As Range, EndTime As Range) As Double
Dim StartTime As Double, aCell As Range
Const c1 = "Bus Departs at", c2 = "Stop #" 'this defines Start Time
RunTime = 0
If EndTime.Value = 0 _
Or Not IsNumeric(EndTime.Value) Then Exit Function
StartTime = 0
For Each aCell In StartTimeRng
If InStr(1, aCell, c1) > 0 Or _
InStr(1, aCell, c2) > 0 Then _
StartTime = aCell.Value
If StartTime > 0 Then Exit For
Next aCell
If StartTime = 0 Then Exit Function
RunTime = EndTime.Value - StartTime
End Function

--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions