Excel Macro to find time gaps

[bamboo1975]

Hi, I have cells with data like below in a column. I wonder, can anyone help me with a macro to search and find any two consecutive cells with over 10 minutes difference and highlight them in yellow? Much appreciated.


[TABLE="width: 121"]
<colgroup><col></colgroup><tbody>[TR]
[TD="align: right"]05/03/2019 06:34
[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 06:57[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 07:16[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 07:19[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 07:25[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 07:29[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 07:53[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 07:57[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:01[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:05[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:07[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:22[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:23[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:23[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:23[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:25[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:25[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:26[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:27[/TD]
[/TR]
[TR]
[TD="align: right"]05/03/2019 08:36[/TD]
[/TR]
</tbody>[/TABLE]

 

[igold]

Hi bamboo1975,

Welcome to the MrExcel Forum.

You asked for a Macro, does this meet your requirements. The code assumes that your data begins in Cell A2 and goes down Column A.

Sub test()


    Dim tim As Range
    Dim i As Long
    
    Set tim = Range("A2", "A" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
    For i = 2 To tim.Cells.Count
        If Format(tim.Cells(i, 1) - tim.Cells(i - 1), "hh:mm;@") > #12:10:00 AM# Then
            tim.Cells(i - 1).Interior.Color = RGB(255, 255, 0)
            If Not tim.Cells(i, 1) = "" Then tim.Cells(i, 1).Interior.Color = RGB(255, 255, 0)
        End If
    Next
    
End Sub

 

[DanteAmor]

Try this:

Sub test()
    For Each t In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If t.Offset(1).Value - t.Value > TimeValue("00:10:00") Then t.Resize(2).Interior.ColorIndex = 6
    Next
End Sub