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

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
527
Office Version
  1. 2019
Platform
  1. Windows
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
AB
210
211136Tue 28/01/2020
212152Wed 05/02/2020
213144Sun 09/02/2020
214166Thu 13/02/2020
215156Mon 17/02/2020
216100Fri 21/02/2020
21798Tue 25/02/2020
21897Sat 29/02/2020
219126Wed 04/03/2020
220142Sun 08/03/2020
221103Thu 12/03/2020
22211TOTAL FOR 2020
223
224135Tue 22/06/2021
22557Sat 26/06/2021
226154Wed 30/06/2021
2277Sun 04/07/2021
228120Mon 12/07/2021
229124Fri 16/07/2021
23051Tue 20/07/2021
231162Sat 24/07/2021
23272Wed 28/07/2021
233101Sun 01/08/2021
2343Thu 05/08/2021
235110Mon 09/08/2021
23640Fri 13/08/2021
23777Tue 17/08/2021
23844Sat 21/08/2021
23968Wed 25/08/2021
2402Sun 29/08/2021
24189Thu 02/09/2021
2424Mon 06/09/2021
24376Fri 10/09/2021
244
24520TOTAL FOR 2021
Iron Man Log
Cell Formulas
RangeFormula
A224:A243,A211:A221A211=RANK(D211,$D$2:$D$245)
A222A222=COUNT(A211:A221)
B222B222="TOTAL FOR " & YEAR(B221)
A245A245=COUNT(A224:A244)
B245B245="TOTAL FOR " & YEAR(B243)
Named Ranges
NameRefers ToCells
Iron_Mans_2020='Iron Man Log'!$A$211:$A$221A222
Cells with Conditional Formatting
CellConditionCell FormatStop If True
A210Cell Value=""textNO
A245Cell Value=""textNO
A244Cell Value=""textNO
A222Cell Value=""textNO
A223Cell Value=""textNO
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:A47Cell Value=1textYES
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:A47Cell Value=2textYES
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:A47Cell Valuebetween 3 and 10textYES
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:A531Cell Value=""textNO
Cells with Data Validation
CellAllowCriteria
A245Whole number=12345
A222Whole number=12345
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,892
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Rich (BB code):
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
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Ironman

Well-known Member
Joined
Jan 31, 2004
Messages
527
Office Version
  1. 2019
Platform
  1. Windows
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

Well-known Member
Joined
Oct 27, 2005
Messages
20,892
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Ok, try it this way....leave the data set where it is currently
VBA Code:
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

Well-known Member
Joined
Oct 27, 2005
Messages
20,892
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
AND for both columns
VBA Code:
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

Well-known Member
Joined
Jan 31, 2004
Messages
527
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Oct 27, 2005
Messages
20,892
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Did you change it to a Worksheet_Change event AND put it in the correct sheet module ??
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,892
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

Try this modified...edited.
VBA Code:
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

Well-known Member
Joined
Jan 31, 2004
Messages
527
Office Version
  1. 2019
Platform
  1. Windows
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
VBA Code:
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

Well-known Member
Joined
Oct 27, 2005
Messages
20,892
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Ok,
1. type CTRL +G and open the Immediates window
Type in
VBA Code:
 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

Well-known Member
Joined
Jan 31, 2004
Messages
527
Office Version
  1. 2019
Platform
  1. Windows
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)
 

Forum statistics

Threads
1,141,298
Messages
5,705,567
Members
421,399
Latest member
hjweiss00

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top