# Show msg box based on consecutive values

#### Oximoxi

##### New Member
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.

### Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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

Code:
``````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``````

Try this:-
Code:
``````[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

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.

Hi Oxi
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 Oxi
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.

This should work if you put this in the sheet module

Code:
``````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``````

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

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?

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

Replies
0
Views
188
Replies
7
Views
273
Replies
11
Views
1K
Replies
18
Views
776
Replies
16
Views
620

1,207,259
Messages
6,077,349
Members
446,279
Latest member
hoangquan2310

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back