Consecutive status in period of 15 minutes

[steve87bg]

Hi can someone help me create macro which will go on all sheets in workbook and searche for consecutive "Failed Status" within the period of 15 minutes and highlight them. Here is the example

time	status
03.11.2015 07:15	Failed
03.11.2015 07:17	Failed
03.11.2015 07:19	Failed
03.11.2015 07:28	Failed
03.11.2015 07:32	Successful
03.11.2015 07:38	Failed

the first 4 rows have consecutive "Failed" status in period of 15 min and they should be highlighted.

Thank you

[steve87bg]

I found some code that can be used but i need to change it.

Sub ColorCells()    Dim cl As Long, N As Long, i As Long, LastCL As Long
    N = Cells(Rows.Count, "A").End(xlUp).Row
    LastCL = Cells(2, Columns.Count).End(xlToLeft).Column
    For cl = 2 To LastCL
    For i = 3 To N
        Set r1 = Cells(i, cl)
        Set r2 = r1.Offset(-1, 0)
        Set r3 = r1.Offset(-2, 0)
        If r1.Value = "Failed" And r2.Value = "Failed" And r3.Value = "Failed" Then
            Union(r1, r2, r3).Interior.Color = RGB(255, 0, 0)
        End If
    Next i
    Next cl
End Sub

bu the problem here is that it should first find "Status" column and check consecutive values there and that see if its in a time of 15 min.

[katanga]

HI,
Why you cannot use conditional format ?
Assuming that your table is in ranga A1:B7, this formula in cell B2 return 1 (4 consecutive faild and time less than 15 minutes (1/96 of day)

IF(AND(B2=B3,B2=B4,B2=B5,B2="Failed",(A5-A2)<=(1/96)),1,0)

[steve87bg]

HI,
Why you cannot use conditional format ?
Assuming that your table is in ranga A1:B7, this formula in cell B2 return 1 (4 consecutive faild and time less than 15 minutes (1/96 of day)

IF(AND(B2=B3,B2=B4,B2=B5,B2="Failed",(A5-A2)<=(1/96)),1,0)

Unfortunately that will not work. Here is the example of what macro should do. Find more than 3 consecutive failed statuses and that that failed statuses are in period of 15 min

ConsecutiveStatus.xlsx

[SamT]

Why are some times out of order?

11/3/2015 8:52	Failed
11/3/2015 8:54	Failed
11/3/2015 8:59	Failed
11/3/2015 9:02	Failed
11/3/2015 9:04	Failed
11/3/2015 8:05	Failed
11/3/2015 8:06	Failed
11/3/2015 8:07	Successful

What if the consecutive failed times exceed 15 minutes
8:05
8:06
8:07
8:19
8:25
8:26

Why wouldn't Katanga's Conditional Format formula work? Logically, it fits all your given parameters. Granted, IMO, it needs to be OR'ed in reverse, but then, I'm not a formula guru, so this is a serious question.

[katanga]

Ok, discard the conditional format.
Try this macro.

Sub ColorCells()
Dim cl As Long, i As Long
Dim LastR As Long, LastC As Long
Dim StatusC As Long, TimeC As Long
Dim r1 As Range, r2 As Range, r3 As Range
Dim t1 As Range, t2 As Range, t3 As Range
Dim bkgColor As Long
Dim w As Worksheet

Const kFail As String = "Failed"
bkgColor = vbYellow 'red RGB(255, 0, 0)

' Worksheets Loop
  For Each w In Worksheets
    w.Select
    LastR = w.Cells(Rows.Count, "A").End(xlUp).Row
    LastC = w.Cells(2, Columns.Count).End(xlToLeft).Column
    StatusC = 0
    TimeC = 0
 ' Detect time and status column
    For cl = 1 To LastC
      Select Case w.Cells(1, cl)
      Case "status"
        StatusC = cl
      Case "time"
        TimeC = cl
      End Select
    Next cl
    if StatusC=0 or TimeC=0 then 
    ' Columns not found
      exit for
    end if
  ' Start from row 4 (First are header)
    For i = 4 To LastR
      Set r1 = w.Cells(i, StatusC)
      Set r2 = r1.Offset(-1, 0)
      Set r3 = r1.Offset(-2, 0)
      If r1.Value = kFail And _
         r2.Value = kFail And _
         r3.Value = kFail Then
        Set t1 = w.Cells(i, TimeC)
        Set t2 = t1.Offset(-1, 0)
        Set t3 = t1.Offset(-2, 0)
        
        If (t1.Value - t3.Value) <= (1 / 96) Then
          Union(r1, r2, r3).Interior.Color = bkgColor
          Union(t1, t2, t3).Interior.Color = bkgColor
        End If
      End If
    Next i
  Next
End Sub

[snb]

Keep it simple:

Sub M_snb()
  Sheet1.Columns(2).AutoFilter 1, "Failed"
  For Each ar In Sheet1.Columns(1).SpecialCells(12).SpecialCells(2, 1).Areas
     If ar.Count > 1 Then
        For j = 2 To ar.Count
            If ar.Cells(j) - ar.Cells(1) < (1 / 96) Then ar.Cells(1).Resize(j).Interior.ColorIndex = 8
        Next
     End If
  Next
End Sub