Issue

I have a spread sheet that tracks attendance. What I want to do is to alert the user whenever 3 OR MORE CELLS IN SEQUENCE CONTAIN THE SAME DATA. eg. If someone calls in sick, a S is placed in the cell, if this person is sick Mon, Tues, Wed, I would like to alert the user. ( 3 days in sequence with the same data ). If the person is sick on Thur aswell, I want to alert the user again.

Solution

1. Press ALT + F11 to open VBE

2. Press CTRL + R to open Project Explorer

3. Double click on the sheet in which you want this message box

4. Paste the code

Private Sub Worksheet_Change(ByVal Target As Range) Dim vPos As Variant Dim iCol As Integer Dim CellValue As Variant If ((Target.Columns.Count = 1) And (Target.Rows.Count = 1)) Then If Target = "" Then Exit Sub End If vPos = "" Application.EnableEvents = False For Each Cell In Target If UCase(Cell) <> "S" Then GoTo Next_Cell vPos = "" iCol = Cell.Column If iCol >= 3 Then If ((Cell = Cell.Offset(0, -2)) And (Cell.Offset(0, -1) = Cell)) Then vPos = -1 End If End If If ((vPos = "") And (iCol >= 2) And (iCol < Columns.Count)) Then If ((Cell = Cell.Offset(0, -1)) And (Cell.Offset(0, 1) = Cell)) Then vPos = 0 End If End If If ((vPos = "") And (iCol < Columns.Count - 1)) Then If ((Cell = Cell.Offset(0, 1)) And (Cell.Offset(0, 2) = Cell)) Then vPos = 1 End If End If If (vPos <> "") Then GoTo End_Sub End If Next_Cell: Next End_Sub: Application.EnableEvents = True If (vPos <> "") Then MsgBox "Three in a row" End If End Sub

If you the alerts to be enabled only for weekdays (Monday to Friday).

Private Sub Worksheet_Change(ByVal Target As Range) Dim vPos As Variant Dim iCol As Integer Dim CellValue As Variant Dim iOffsetL2 As Integer Dim iOffsetL1 As Integer Dim iOffsetR1 As Integer Dim iOffset2 As Integer Dim CellL2 As Variant Dim CellL1 As Variant Dim Cell0 As Variant Dim CellR1 As Variant Dim CellR2 As Variant If ((Target.Columns.Count = 1) And (Target.Rows.Count = 1)) Then If Target = "" Then Exit Sub End If vPos = "" ' Exit Sub On Error GoTo End_Sub Application.EnableEvents = False For Each Cell In Target Cell0 = UCase(Cell.Value) 'If Cell0 <> "S" Then GoTo Next_Cell vPos = "" iOffsetL2 = 0 iOffsetL1 = 0 iOffsetR1 = 0 iOffsetR2 = 0 iCol = Cell.Column If (IsDate(Cells(1, iCol))) Then CellL2 = "Garbage Value" CellL1 = "Garbage Value" CellR1 = "Garbage Value" CellR2 = "Garbage Value" Select Case (Weekday(Cells(1, iCol), vbMonday)) Case Is = 1 iOffsetL2 = -2 iOffsetL1 = -2 iOffsetR1 = 0 iOffsetR2 = 0 Case Is = 2 iOffsetL2 = -2 iOffsetL1 = 0 iOffsetR1 = 0 iOffsetR2 = 0 Case Is = 4 iOffsetL2 = 0 iOffsetL1 = 0 iOffsetR1 = 0 iOffsetR2 = 2 Case Is = 5 iOffsetL2 = 0 iOffsetL1 = 0 iOffsetR1 = 2 iOffsetR2 = 2 End Select End If On Error Resume Next CellL2 = Cell.Offset(0, (-2 + iOffsetL2)).Value CellL1 = Cell.Offset(0, (-1 + iOffsetL1)).Value CellR1 = Cell.Offset(0, (1 + iOffsetR1)).Value CellR2 = Cell.Offset(0, (2 + iOffsetR2)).Value On Error GoTo End_Sub CellL2 = UCase(CellL2) CellL1 = UCase(CellL1) CellR1 = UCase(CellR1) CellR2 = UCase(CellR2) If (iCol + iOffsetL2 > 2) Then ' ? ? X If ((CellL2 = Cell0) And (CellL1 = Cell0)) Then vPos = -1 GoTo End_Sub End If End If If ((iCol + iOffsetL1 > 0) And ((iCol - iOffsetR1) < Columns.Count)) Then ' ? X ? If ((CellL1 = Cell0) And (Cell0 = CellR1)) Then vPos = 0 GoTo End_Sub End If End If If (iCol < Columns.Count - 1) Then ' X ? ? If ((Cell0 = CellR1) And (Cell0 = CellR2)) Then vPos = 1 GoTo End_Sub End If End If Next_Cell: Next End_Sub: Application.EnableEvents = True If (vPos <> "") Then MsgBox "Three in a row" End If End Sub

Thanks to rizvisa1 for this tip.