Sub LocTangCa()
Dim Rws As Long, J As Long, W As Long, Tmr As Double
Dim Arr()
Rws = Sheet1.[c2].CurrentRegion.Rows.Count
ReDim dArr(1 To Rws, 1 To 3)
Arr() = Sheet1.[c2].Resize(Rws, 2).Value
For J = 1 To UBound(Arr())
Tmr = TimeSerial(Hour(Arr(J, 2)), Minute(Arr(J, 2)), Second(Arr(J, 2)))
If Tmr > TimeSerial(17, 30, 0) Then
W = W + 1: dArr(W, 1) = Arr(J, 1)
dArr(W, 2) = Format(Arr(J, 2), "MM/dd/yyyy")
dArr(W, 3) = Format(Tmr, "hh:mm:0")
End If
Next J
Sheet1.[L2].Resize(W, 3).Value = dArr()
End Sub