Msgbox when any one of a number of subtotals has been exceeded

[Ironman]

Hi

A2:A243 (which is added to regularly) contains values and subtotals for each year.

The subtotals for each year are identified in blue and by a formula in Column B.

I need a message box to appear when the value in cell A245 exceeds a subtotal.

If a trigger cell is needed, then C245 can be used (so I can easily see it), although this will need to change when a new entry is added.

Many thanks!

Book1
	A	B
210
211	136	Tue 28/01/2020
212	152	Wed 05/02/2020
213	144	Sun 09/02/2020
214	166	Thu 13/02/2020
215	156	Mon 17/02/2020
216	100	Fri 21/02/2020
217	98	Tue 25/02/2020
218	97	Sat 29/02/2020
219	126	Wed 04/03/2020
220	142	Sun 08/03/2020
221	103	Thu 12/03/2020
222	11	TOTAL FOR 2020
223
224	135	Tue 22/06/2021
225	57	Sat 26/06/2021
226	154	Wed 30/06/2021
227	7	Sun 04/07/2021
228	120	Mon 12/07/2021
229	124	Fri 16/07/2021
230	51	Tue 20/07/2021
231	162	Sat 24/07/2021
232	72	Wed 28/07/2021
233	101	Sun 01/08/2021
234	3	Thu 05/08/2021
235	110	Mon 09/08/2021
236	40	Fri 13/08/2021
237	77	Tue 17/08/2021
238	44	Sat 21/08/2021
239	68	Wed 25/08/2021
240	2	Sun 29/08/2021
241	89	Thu 02/09/2021
242	4	Mon 06/09/2021
243	76	Fri 10/09/2021
244
245	20	TOTAL FOR 2021
Iron Man Log

Cell Formulas
Range	Formula
A224:A243,A211:A221	A211	=RANK(D211,$D$2:$D$245)
A222	A222	=COUNT(A211:A221)
B222	B222	="TOTAL FOR " & YEAR(B221)
A245	A245	=COUNT(A224:A244)
B245	B245	="TOTAL FOR " & YEAR(B243)

Named Ranges
Name	Refers To	Cells
Iron_Mans_2020	='Iron Man Log'!$A$211:$A$221	A222

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A210	Cell Value	=""	text	NO
A245	Cell Value	=""	text	NO
A244	Cell Value	=""	text	NO
A222	Cell Value	=""	text	NO
A223	Cell Value	=""	text	NO
A2:A6,A211:A221,A182:A208,A177:A179,A153:A174,A149:A150,A138:A146,A112:A135,A98:A109,A90:A95,A87,A78:A84,A75,A68:A72,A58:A65,A55,A50:A52,A38:A43,A35,A23:A32,A9:A20,A224:A243,A46:A47	Cell Value	=1	text	YES
A2:A6,A211:A221,A182:A208,A177:A179,A153:A174,A149:A150,A138:A146,A112:A135,A98:A109,A90:A95,A87,A78:A84,A75,A68:A72,A58:A65,A55,A50:A52,A38:A43,A35,A23:A32,A9:A20,A224:A243,A46:A47	Cell Value	=2	text	YES
A2:A6,A211:A221,A182:A208,A177:A179,A153:A174,A149:A150,A138:A146,A112:A135,A98:A109,A90:A95,A87,A78:A84,A75,A68:A72,A58:A65,A55,A50:A52,A38:A43,A35,A23:A32,A9:A20,A224:A243,A46:A47	Cell Value	between 3 and 10	text	YES
A2:A6,A211:A221,A182:A208,A177:A179,A153:A174,A149:A150,A138:A146,A112:A135,A98:A109,A90:A95,A87,A78:A84,A75,A68:A72,A58:A65,A55,A50:A52,A38:A43,A35,A23:A32,A9:A20,A224:A243,A46:A47,A246:A531	Cell Value	=""	text	NO

Cells with Data Validation
Cell	Allow	Criteria
A245	Whole number	=12345
A222	Whole number	=12345

 

[Michael M]

Maybe if I relocated it at the top, to the right of the data,

Any time you have differing sets of data in the same columns you are going to have coding issues, if they are not working together

 

[Ironman]

Ahh, OK. I guess this one isn't straight forward for you. I can always conditional format another cell to highlight some text to alert me instead?

 

[Michael M]

Ok, try it this way....leave the data set where it is currently

Sub MM4()
Dim r As Long, lr As Long, n As Integer, fr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A" & lr).CurrentRegion
fr = rng.Row + 1
n = Evaluate("=MAX(IF(C" & fr & ":C" & lr - 1 & "<C" & lr & ",C" & fr & ":C" & lr - 1 & ",""""))")
For r = lr - 1 To fr Step -1
If n = Cells(r, 3) Then
    MsgBox "You've just surpassed the number of runs for " & Cells(r, 3).Offset(0, -1).Value
    Exit For
End If
Next
End Sub

 

[Michael M]

AND for both columns

Sub MM1()
Dim r As Long, lr As Long, n As Integer, fr As Long, X As Integer
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A" & lr).CurrentRegion
fr = rng.Row + 1
n = Evaluate("=MAX(IF(C" & fr & ":C" & lr - 1 & "<C" & lr & ",C" & fr & ":C" & lr - 1 & ",""""))")
X = Evaluate("=MAX(IF(F" & fr & ":F" & lr - 1 & "<F" & lr & ",F" & fr & ":F" & lr - 1 & ",""""))")
For r = lr - 1 To fr Step -1
If n = Cells(r, 3) Then
    MsgBox "You've just surpassed the number of runs for " & Cells(r, 3).Offset(0, -1).Value
    n = 100
    End If
If X = Cells(r, 6) Then
    MsgBox "You've just surpassed the number of runs for " & Cells(r, 6).Offset(0, -1).Value
    Exit For
End If
Next r
End Sub

 

[Ironman]

Hey Michael you're spoiling me

I used #13 and changed a value to make it trigger the msgbox and it worked, but only once

I then replaced it with #14 and changed a value in both columns (1 at a time) to make it trigger the msgbox for each of the columns and it didn't work (no error, no msgbox)

I then went back to #13, changed a value to make it trigger the msgbox and again, it didn't work (no error, no msgbox)

I saved and exited the workbook, went back in, changed a value to make it trigger the msgbox but still no error and no msgbox.

 

[Michael M]

Did you change it to a Worksheet_Change event AND put it in the correct sheet module ??

 

[Michael M]

Try this modified...edited.

Sub MM41()
Dim r As Long, lr As Long, n As Integer, fr As Long, X As Integer
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A" & lr).CurrentRegion
fr = rng.Row + 1
n = Evaluate("=MAX(IF(C" & fr & ":C" & lr - 1 & "<C" & lr & ",C" & fr & ":C" & lr - 1 & ",""""))")
X = Evaluate("=MAX(IF(F" & fr & ":F" & lr - 1 & "<F" & lr & ",F" & fr & ":F" & lr - 1 & ",""""))")
For r = lr - 1 To fr Step -1
If n = Cells(r, 3) Then
    MsgBox "You've just surpassed the number of runs <= 3 hrs for " & Cells(r, 3).Offset(0, -1).Value
    n = 100
    End If
If X = Cells(r, 6) Then
    MsgBox "You've just surpassed the number of runs > 3hrs for " & Cells(r, 6).Offset(0, -1).Value
    X = 100
End If
Next r
End Sub

 

[Ironman]

Sure did. I just excluded "subMM1()" and "End Sub" as there's another change event in the sheet but the other sub can't be an issue as it was already there on the only occasion the code worked.

I added a couple of formulas at the bottom of column F that would highlight a message with conditional formatting if the rank changed. I removed those just in case but it made no difference, still not working, wish I knew why it worked only once and nothing since.

Here's the entire sheet code FYI

Private Sub Worksheet_Change(ByVal target As Range)

'11.09.2021 Courtesy of Michael M https://www.mrexcel.com/board/threads/msgbox-when-any-one-of-a-number-of-subtotals-has-been-exceeded.1181552/
'The below code triggers msgbox when ranking changes
Dim r As Long, lr As Long, n As Integer, fr As Long, X As Integer
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A" & lr).CurrentRegion
fr = rng.Row + 1
n = Evaluate("=MAX(IF(C" & fr & ":C" & lr - 1 & "<C" & lr & ",C" & fr & ":C" & lr - 1 & ",""""))")
X = Evaluate("=MAX(IF(F" & fr & ":F" & lr - 1 & "<F" & lr & ",F" & fr & ":F" & lr - 1 & ",""""))")
For r = lr - 1 To fr Step -1
If n = Cells(r, 3) Then
    MsgBox "You've just surpassed the number of runs for " & Cells(r, 3).Offset(0, -1).Value
    n = 100
    End If
If X = Cells(r, 6) Then
    MsgBox "You've just surpassed the number of runs for " & Cells(r, 6).Offset(0, -1).Value
    X = 100
End If
Next r

If Range("IRONMAN_RUNS_TOTAL") = 200 Then
If Sheets("Training Log").Range("H8") = "" Then
MsgBox "You've just run your 200th Iron Man Run!", vbInformation, "Iron Man Runs"
Sheets("Training Log").Range("H8") = "1"
End If
End If

End Sub

 

[Michael M]

Ok,
1. type CTRL +G and open the Immediates window
Type in

 application.EnableEvents=True

and press enter...rerun the code
2. what range is Range("IRONMAN_RUNS_TOTAL") ??
It should be something more like If range (yourcell range)="IRONMAN_RUNS_TOTAL" then...unless it's a named range

 

[Ironman]

IRON_RUNS_TOTAL is a named range, single cell A248 (2 rows below the table) - the table runs from A224:A246 (row 246 is for 2021)