Show msg box based on consecutive values

[Oximoxi]

Hi all,

I'm struggling with one problem. I have a spreadsheet, where numbers are filled into columns A,B,C in values from 1 to 15. And I'd like excel to show msg box based on theese two conditions:

1. if 3 consecutive rows contain number lower than 5
2. if 3 consecutive rows contain number higher than 10

Show msg based on the value is no problem, but I don't know how to deal with the consecutive condition.

Thanks for any help!

Oxi.

 

[EFANYoutube]

I hope this is what your after?
Seems you wanted to know how many groups of 3 consecutive rows contained numbers under 5 and the same for over 10
Let me know if this is correct

Sub Consecutive()
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 Or NumberRow.Offset(0, 1).Value < 5 Or NumberRow.Offset(0, 2).Value < 5 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 Sub

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG25Jan20
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMin [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] a [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] b [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]With[/COLOR] Application
    [COLOR="Navy"]For[/COLOR] n = 0 To 2
        oMax = .Max(Dn.Offset(n).Resize(, 3))
        [COLOR="Navy"]If[/COLOR] oMax > 10 [COLOR="Navy"]Then[/COLOR] a = a + 1
        oMin = .Min(Dn.Offset(n).Resize(, 3))
        [COLOR="Navy"]If[/COLOR] oMin < 5 [COLOR="Navy"]Then[/COLOR] b = b + 1
    [COLOR="Navy"]Next[/COLOR] n
        [COLOR="Navy"]If[/COLOR] a = 3 [COLOR="Navy"]Then[/COLOR] MsgBox "Greater than 10 :- Address = " & Dn.Resize(3, 3).Address
        [COLOR="Navy"]If[/COLOR] b = 3 [COLOR="Navy"]Then[/COLOR] MsgBox "Less than 5 :- Address = " & Dn.Resize(3, 3).Address
        a = 0: b = 0
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Oximoxi]

Thanks a lot!
Unfortunately, thant's not quite what I ment. You see, the numbers are filled in by different people. They fill in 3 numbers in each row, into column A, B and C. What I need is a msg box wich will alert them to do something, when there are 3 consecutive rows containing number lower than 5 or higher than 10.

 

[EFANYoutube]

Hi Oxi
Hope I can help you get this right
So by consecutive you mean rows together? Numbers are entered into row 10, if the previous 2 rows and the current one qualify one of the conditions you want a message box?
Or any of the rows like 3,4 and 5?

I just need more detail I think

 

[Oximoxi]

Hi Oxi
Hope I can help you get this right
So by consecutive you mean rows together? Numbers are entered into row 10, if the previous 2 rows and the current one qualify one of the conditions you want a message box?
Or any of the rows like 3,4 and 5?

I just need more detail I think

Hi,
thanks a lot for your effort! Yes, I mean rows together. For example if all of rows 10, 11, 12 contain either value lower than 5, or higher than 10, I'd like the msg to pop up.

 

[EFANYoutube]

This should work if you put this in the sheet module

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

 

[Oximoxi]

I tryed, but unfortunately, it doesn't work. It does nothing.

 

[EFANYoutube]

I tryed, but unfortunately, it doesn't work. It does nothing.

No error or anything?
Did you put the code in the "Sheet Module"? eg Sheet1 (Sheet1) in the project explorer window?

 

[Oximoxi]

Yes, I did. No error or anything. It's doing nothing at all. I don't get it. :D