```
Private Sub Worksheet_Change(ByVal Target As Range)
If Me.Cells(Target.Row, 1).Value <> "" And Me.Cells(Target.Row, 2).Value <> "" And Me.Cells(Target.Row, 3).Value <> "" Then
Dim Under5, Over10, ReturnUnder5, ReturnOver10 As Integer
Dim NumberRng, NumberRow As Range
Set NumberRng = ThisWorkbook.Sheets("Sheet1").Range("A1:A15")
For Each NumberRow In NumberRng
'Check for numbers under 5
If NumberRow.Value < 5 And NumberRow.Value > 0 _
Or NumberRow.Offset(0, 1).Value < 5 And NumberRow.Offset(0, 1).Value > 0 _
Or NumberRow.Offset(0, 2).Value < 5 And NumberRow.Offset(0, 2).Value > 0 Then
Under5 = Under5 + 1
Else
Under5 = 0
End If
'Check for numbers over 10
If NumberRow.Value > 10 Or NumberRow.Offset(0, 1).Value > 10 Or NumberRow.Offset(0, 2).Value > 10 Then
Over10 = Over10 + 1
Else
Over10 = 0
End If
'Check if either are a consecutive 3
If Under5 = 3 Then
ReturnUnder5 = ReturnUnder5 + 1
Under5 = 0
End If
If Over10 = 3 Then
ReturnOver10 = ReturnOver10 + 1
Over10 = 0
End If
Next NumberRow
'Now the message box
MsgBox "You have " & ReturnUnder5 & " group of 3 consecutive rows with numbers under 5" & vbNewLine _
& "and " & ReturnOver10 & " group of 3 consecutive rows with numbers over 10"
End If
End Sub
```