View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
drum118 drum118 is offline
external usenet poster
 
Posts: 4
Default RunTime code problem

Cannot get this code to work.

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

This is how the cols look and how it will work.
Col A Col O Col T Col AA Col BB Col BD
Row 6 Bus Departs Stop#1987 Stop#1434 Stop#1887 RunTime
at
Row 7 12:23:23 0:00:00 12:43:22 12:55:33 0:32:10
Row 8 0:00:00 14:22:10 0:00:00 14:44:50 0:22:40
Row 9 07:12:55 07:14:00 07:30:22 07:44:44 0:31:49
Row 10 0:00:00 0:00:00 14:44:54 14:55:55 0:11:01

The start point is based on the first cell to have a time enter into it
and the RunTime is based on the cell before the RunTime cell.

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

Thanks