Loop through column and conditionally subtract

[enjam]

Hi there,

I've got a list of buses that operate in my area, and want to figure out how long it's been since the last bus with the same stopping condition operated.

I'm trying to create a macro that subtracts the time difference between two values in Column B, based on the condition in Column C, and populates this into Column D (Column E has the desired values that I've manually calculated).

Unsure where to even begin with this one. Any help would be greatly appreciated :)

27922

[Dave]

Hi enjam. You can trial this code. It seems to work but... it does not work across days ie. when the bus leaves at 2355hrs and arrives at 0001hrs it outputs a -1434 minutes instead of 6 minutes. Other than this, it seems to be OK. Perhaps others can adjust the code to address this error... I can't seem to fix it. HTH. Dave

Sub Test()Dim LastRow As Integer, BusArr As Variant, ArCnt As Integer
Dim RowCnt As Integer, NewCnt As Integer, StartTime As String
With Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
BusArr = Array("A", "B", "C")
For ArCnt = LBound(BusArr) To UBound(BusArr)
For RowCnt = 1 To LastRow
If Sheets("sheet1").Range("C" & RowCnt) = BusArr(ArCnt) Then
StartTime = Sheets("sheet1").Range("B" & RowCnt)
For NewCnt = RowCnt + 1 To LastRow
If Sheets("sheet1").Range("C" & NewCnt) = BusArr(ArCnt) Then
Sheets("sheet1").Range("D" & NewCnt) = _
DateDiff("n", StartTime, Sheets("sheet1").Range("B" & NewCnt))
Exit For
End If
Next NewCnt
End If
Next RowCnt
Next ArCnt
End Sub

[SamT]

In standard Module

Function WaitTime(ArriveCell As Range, DepartCell As Range, ConditionCell As Range)
Dim Depart As Date. Arrive As Date

Depart = DepartCell
Arrive = ArriveCell
'Depart and Arrive are times on the Zeroth day of Jan, 1900

If Depart < Arrive then Depart = Depart + 1 'Adds 1 day (24 hours)

'check Conditions here, edit below to suit conditions

WaitTime = Format(Depart - Arrive, "mm Mins")
End Function
In TimeDifference Cell
"=WaitTime(A3,B3,C3)"

[Dave]

Thanks for the information SamT. This now works. Dave

Sub Test()Dim LastRow As Integer, BusArr As Variant, ArCnt As Integer
Dim RowCnt As Integer, NewCnt As Integer, StartTime As Date
With Sheets("Sheet1")
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
End With

BusArr = Array("A", "B", "C")
For ArCnt = LBound(BusArr) To UBound(BusArr)
For RowCnt = 1 To LastRow
If Sheets("sheet1").Range("C" & RowCnt) = BusArr(ArCnt) Then
StartTime = Sheets("sheet1").Range("B" & RowCnt)
For NewCnt = RowCnt + 1 To LastRow
If Sheets("sheet1").Range("C" & NewCnt) = BusArr(ArCnt) Then
If StartTime > Sheets("sheet1").Range("B" & NewCnt) Then
Sheets("sheet1").Range("D" & NewCnt) = _
Abs(DateDiff("n", Sheets("sheet1").Range("B" & NewCnt) + 1, StartTime))
Sheets("sheet1").Range("D" & NewCnt).NumberFormat = "##"
Else
Sheets("sheet1").Range("D" & NewCnt) = _
DateDiff("n", StartTime, Sheets("sheet1").Range("B" & NewCnt))
End If
Exit For
End If
Next NewCnt
End If
Next RowCnt
Next ArCnt
End Sub

[enjam]

Amazing! thank you very much Dave and SamT, works exactly as intended. Much appreciated :)

[Dave]

You are welcome. Thanks for posting your outcome. Be safe. Dave

[SamT]

:thumb

[snb]

Alternative:


Sub M_snb()
sn = sheet1.Cells(2, 1).CurrentRegion.Resize(, 4)
ReDim sp(2)

For j = 2 To UBound(sn)
y = Asc(sn(j, 3)) - 65
If sp(y) > 0 Then sn(j, 4) = Format(1 + sn(j, 2) - sp(y), "hh:mm")
sp(y) = sn(j, 2)
Next

sheet1.Cells(2, 1).CurrentRegion.Resize(, 4) = sn
End Sub

[Dave]

Hi snb. Nice but "It seems to work but... it does not work across days ie. when the bus leaves at 2355hrs and arrives at 0001hrs" :) Dave
edit: whoops it seems like my formatting was residual on the relevant cells. I should have known better. My apologies.
Need to add this to last line of code...

Sheet1.Cells(2, 1).CurrentRegion.NumberFormat = "hh:mm"

[snb]

A matrix formula in D1 will do as well:


=IFERROR(1+$B3-INDEX($B$2:$B2;MAX(($C$2:$C2=$C3)*ROW($1:1)));"")