RunTime code problem

[drum118]

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

 

[Dave Peterson]

How about just a worksheet formula dragged down the column?

In E7:
=MAX(A77)-MIN(IF(A77>0,A77))
(ctrl-shift-enter instead of just enter)
This is an array formula and excel will wrap the formula with curly brackets {}
if you do it correctly.

(format the cell in your favorite time format)

 

[Dave Peterson]

One thing with a userdefined function is that you'd want to pass it the cells
that should cause the function to reevaluate.

Alternatively, you could put application.volatile at the top of your code and
everytime excel recalcs, your function would be recalculated.

So my worksheet function would need to have both the label range and the time
range passed to it, like:

=runtime($A$5:$D$5,A77)
(the $'s mean that I can drag it down and $a5:$d$5 won't change.)

My code would look like this:

Option Explicit

Function RunTime(labelRng As Range, timeRng As Range) As Variant

Dim iCtr As Long
Dim startTime As Double
Dim endTime As Double

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

If labelRng.Cells.Count <> timeRng.Cells.Count Then
RunTime = "Cell Count Mismatch!"
Exit Function
ElseIf labelRng.Areas.Count <> 1 _
Or timeRng.Areas.Count <> 1 Then
RunTime = "Too many areas!"
Exit Function
ElseIf Application.Count(timeRng) <> timeRng.Cells.Count Then
RunTime = "Non-Numeric Data in TimeRng!"
Exit Function
End If

'no checks for labels like starttime?????
'maybe looking for that string is not necessary, huh?
With timeRng
endTime = .Cells(.Cells.Count).Value
If endTime = 0 Then
RunTime = 0
Exit Function
End If
End With

startTime = 0
For iCtr = 1 To timeRng.Cells.Count
If (InStr(1, labelRng.Cells(iCtr), c1, vbTextCompare) > 0 _
Or InStr(1, labelRng.Cells(iCtr), c2, vbTextCompare) > 0) _
And timeRng.Cells(iCtr) > 0 Then
startTime = timeRng.Cells(iCtr).Value
Exit For
End If
Next iCtr

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

RunTime = endTime - startTime

End Function

The formatting for the cell doesn't come from your function. It comes from the
way you formatted the cell. So I just dropped all that stuff and subtracted the
two times. As long as you have the cell formatted correctly, it'll look nice.

It seemed to work in light testing. But I think I may have used a bigger
worksheet formula or even some helper cells to break it into pieces.

 

[drum118]

One thing with a userdefined function is that you'd want to pass it the cells
that should cause the function to reevaluate.

Alternatively, you could put application.volatile at the top of your code and
everytime excel recalcs, your function would be recalculated.

So my worksheet function would need to have both the label range and the time
range passed to it, like:

=runtime($A$5:$D$5,A77)
(the $'s mean that I can drag it down and $a5:$d$5 won't change.)

My code would look like this:

Option Explicit

Function RunTime(labelRng As Range, timeRng As Range) As Variant

Dim iCtr As Long
Dim startTime As Double
Dim endTime As Double

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

If labelRng.Cells.Count <> timeRng.Cells.Count Then
RunTime = "Cell Count Mismatch!"
Exit Function
ElseIf labelRng.Areas.Count <> 1 _
Or timeRng.Areas.Count <> 1 Then
RunTime = "Too many areas!"
Exit Function
ElseIf Application.Count(timeRng) <> timeRng.Cells.Count Then
RunTime = "Non-Numeric Data in TimeRng!"
Exit Function
End If

'no checks for labels like starttime?????
'maybe looking for that string is not necessary, huh?
With timeRng
endTime = .Cells(.Cells.Count).Value
If endTime = 0 Then
RunTime = 0
Exit Function
End If
End With

startTime = 0
For iCtr = 1 To timeRng.Cells.Count
If (InStr(1, labelRng.Cells(iCtr), c1, vbTextCompare) > 0 _
Or InStr(1, labelRng.Cells(iCtr), c2, vbTextCompare) > 0) _
And timeRng.Cells(iCtr) > 0 Then
startTime = timeRng.Cells(iCtr).Value
Exit For
End If
Next iCtr

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

RunTime = endTime - startTime

End Function

The formatting for the cell doesn't come from your function. It comes from the
way you formatted the cell. So I just dropped all that stuff and subtracted the
two times. As long as you have the cell formatted correctly, it'll look nice.

It seemed to work in light testing. But I think I may have used a bigger
worksheet formula or even some helper cells to break it into pieces.

<snip>
The problem I see is "Bus Departs at" will always be in col O (15) all
the time for "Stop #" can be anywhere between col T to DD depending on
the book. Some have only 25 "Stop #" will other may have up to 55.
Placing RunTime various from numbers for them to locations of them in
various books.

I want to know how long it took from first record time to the last
record time requiring a RunTime. Runtime is use to calculate the
operating cost of the bus. So I would have something like this:

Col O R S Z AA AD AE BB BC
Depart Stop Run Stop Run Stop Run Stop Run
0:00:00 0:00:00 0:00:00 0:00:00 0:00:00 0:00:00 0:00:00 0:00:00
0:00:00
0:00:00 07:30.55 0:00:00 07:55:55 0:20:00 08:11:33 0:40:38 8:15:22
0:44:27
0:00:00 0:00:00 0:00:00 0:00:00 14:22:12 14:44:44 0:22:22 0:00:00
0:00:00
0:00:00 19:12:12 0:00:00 19:33:33 0:19:19 0:00:00 0:00:00 0:00:00
0:00:00
12:12:12 12:13:23 0:01:11 12:22:33 0:20:11 12:44:44 0:32:32 13:23:33
01:09:11
Cells are formatted as 15:13:00 using 24 clock.

All I had to do with my script was use =RunTime(xx) in the cell I wanted
a RunTime enter.

Want to make sure on the first 2 before I start building 160 books and
about 200 rows per book min.

Just making sure on your =RunTime($O$6:$dd$6,O7E7) Row 6 has the text
info, row 7 to 200 will have the data.

 

[Dave Peterson]

Try it with some test data to see if it works. In fact, keep both versions.
Call one =runtime() and the other =runtime2().

Then put the same data in consecutive rows with =runtime() in the odd and
=runtime2(). Make a few changes to the data and watch the functions
recalculate.