VBA - Combine Multiple Message Box into a single box

[hmltnangel]

Hi all,

Hope you can figure out the last little bit (hopefully) that can combine these queries into one message box. Instead of three boxes, one after the other.

Private Sub Worksheet_Change(ByVal Target As Range) 'WS change is whenever a value in target cell is changed
Dim cell As Range

If Target.Value > 0 Then
            If Target.DisplayFormat.Interior.Color = 8696052 Then
            MsgBox "DH Warning: Individuals Comp Ratio is in excess of 120%. Recommendation is that Merit Award does not exceed 1%", Title:=("Comp Ratio High")
            End If
End If

    If Intersect(Target, Range("AB4:AB2000")) Is Nothing Then Exit Sub

'   Check value in column 22
    If Cells(Target.Row, 22).Value = "0 - Too new to rate" Then
        MsgBox "Too New To Rate: This employee has not had a formal Performance Appraisal for FY23. Please ensure that the performance is still factored into your merit decision.", Title:=("Performance Rating")
    End If

For Each cell In Range("AC4:AC2000")
If cell.Value = "Individual Budget Exceeded" Then
    MsgBox "You have exceeded the Individual Budget for this person. Please ensure this is correct before confirming", Title:=("Individual Budget Exceeded")
End If
Next cell

End Sub

 

[Joe4]

Keep building your message in a string, and display it at the end of all three; something like this:

Private Sub Worksheet_Change(ByVal Target As Range) 'WS change is whenever a value in target cell is changed

    Dim cell As Range
    Dim msg As String

    If Target.Value > 0 Then
        If Target.DisplayFormat.Interior.Color = 8696052 Then
            msg = "DH Warning: Individuals Comp Ratio is in excess of 120%. Recommendation is that Merit Award does not exceed 1%"
        End If
    End If

    If Intersect(Target, Range("AB4:AB2000")) Is Nothing Then Exit Sub

'   Check value in column 22
    If Cells(Target.Row, 22).Value = "0 - Too new to rate" Then
        msg = msg & vbCrLf & vbCrLf & "Too New To Rate: This employee has not had a formal Performance Appraisal for FY23. Please ensure that the performance is still factored into your merit decision."
    End If

    For Each cell In Range("AC4:AC2000")
        If cell.Value = "Individual Budget Exceeded" Then
            msg = msg & vbCrLf & vbCrLf & "You have exceeded the Individual Budget for this person. Please ensure this is correct before confirming"
        End If
    Next cell

'   See if any message to return
    If msg <> "" Then MsgBox msg, Title:="Issues to Address"

End Sub

 

[hmltnangel]

That simple?

Although it still gives me two boxes. Eg: one for the low comp ratio and one with the combined messages after it

 

[Joe4]

I tested the code and it works for me without any issues.

Have you copy/pasted my ENTIRE code, as-is, without making any edits or changes to it?

If you then try to compile it before running it, do you get any error messages?
If so, does it give you a "Debug" option, and if it does and you click it, which line of code does it highlight?

 

[hmltnangel]

I tested the code and it works for me without any issues.

Have you copy/pasted my ENTIRE code, as-is, without making any edits or changes to it?

If you then try to compile it before running it, do you get any error messages?
If so, does it give you a "Debug" option, and if it does and you click it, which line of code does it highlight?

Sorry - Joe, my error - typo in the code as I retyped it instead of copying. However it still gives me two boxes. Eg: one for the low comp ratio and one with the combined messages after it

 

[Joe4]

Sorry - Joe, my error - typo in the code as I retyped it instead of copying. However it still gives me two boxes. Eg: one for the low comp ratio and one with the combined messages after it

The only way that can happen in my code is if the code is being triggered twice, as there is only one message box in the entire code!

I also noticed a design issue with your original code, specifically with this line here:

    If Intersect(Target, Range("AB4:AB2000")) Is Nothing Then Exit Sub

That code exit for code after the first check before it gets to the other two. So if the first condition is met, but the line above is not, it will exit the code before popping up the message box.

I think we need to step a back and talk about how each check is working and when it should be fired.
Below is a summary of how each part is currently working. Please be sure to answer/address all the questions in red.

First check:
- checking to see if any updated cell has an interior color code of 869052
- question: should this be checking ALL cells in the entire workbook, or just a specific column or range?

Second check:
- checking to see if a cell is updated in the range AB4:AB2000, and if so, see if the value in column "V" of that particular row is set to "0 - Too new to rate"
- question: is there a formula in column V? Does it get changed/update when column AB is updated (trying to understand the relationship between AB and V)?

Third check:
- checking to see if a cell is updated in the range AB4:AB2000, and if so, check EVERY single cell in the range AC4:AC2000 and see if any are set to "Individual Budget Exceeded"
- question: is there a formula in column AC? Does it get changed/update when column AB is updated (trying to understand the relationship between AB and AC)?
and if an update is made in AB4:AB2000, do we really need to check EVERY single cell in that column, or just the column of the row that was just updated in column AC?

 

[hmltnangel]

The only way that can happen in my code is if the code is being triggered twice, as there is only one message box in the entire code!

I also noticed a design issue with your original code, specifically with this line here:

    If Intersect(Target, Range("AB4:AB2000")) Is Nothing Then Exit Sub

That code exit for code after the first check before it gets to the other two. So if the first condition is met, but the line above is not, it will exit the code before popping up the message box.

I think we need to step a back and talk about how each check is working and when it should be fired.
Below is a summary of how each part is currently working. Please be sure to answer/address all the questions in red.

First check:
- checking to see if any updated cell has an interior color code of 869052
- question: should this be checking ALL cells in the entire workbook, or just a specific column or range?

- Only Cells AB4:AB2000

Second check:
- checking to see if a cell is updated in the range AB4:AB2000, and if so, see if the value in column "V" of that particular row is set to "0 - Too new to rate"
- question: is there a formula in column V? Does it get changed/update when column AB is updated (trying to understand the relationship between AB and V)?

- V is an index match but should never change after initial completion. AB does not update or affect this column. AB only looks here for a specific value

Third check:
- checking to see if a cell is updated in the range AB4:AB2000, and if so, check EVERY single cell in the range AC4:AC2000 and see if any are set to "Individual Budget Exceeded"
- question: is there a formula in column AC? Does it get changed/update when column AB is updated (trying to understand the relationship between AB and AC)?
and if an update is made in AB4:AB2000, do we really need to check EVERY single cell in that column, or just the column of the row that was just updated in column AC?

AC - if the value in Column AB of the same row is too high then it will flag to say Ind Budget Exceeded in AC. So in essence we should only check the corresponding AC cell in that row.

 

[Joe4]

I am confused about the second check, how it relates to the fields you are checking in this, and when that part of the code should be fired.
Can you post the exact formula found in cell V4, and explain in more detail exactly what you are trying to do with the second check?

 

[hmltnangel]

Thanks Joe,

I have made certain changes regardless, as the requirements changed slightly. One argument removed, one added. (I didnt agree with one of the popups being required). So it has now become this.

The Intersect is nothing then exit piece was to stop it running through if the cell is blank. I have moved that up in the code.

After changing to this, then saving and restarting Excel. It works perfect. Or at least it appears to work perfect

The fomrula you asked is as follows:

=IFERROR(IF(INDEX(ratings[Final Performance Rating],MATCH([@[Unique ID ]],ratings[Unique ID],0))="","0 - Too new to rate",INDEX(ratings[Final Performance Rating],MATCH([@[Unique ID ]],ratings[Unique ID],0))),"0 - Too new to rate")

Private Sub Worksheet_Change(ByVal Target As Range) 'WS change is whenever a value in target cell is changed

Dim cell As Range
Dim msg As String

' Colour Checker - MsgBox Target.DisplayFormat.Interior.Color -

    If Intersect(Target, Range("AB4:AB2000")) Is Nothing Then Exit Sub

If Target.Value > 0 Then
            If Target.DisplayFormat.Interior.Color = 8696052 Then
            msg = "High Comp Ratio: Individuals Comp Ratio is in excess of 120%. Recommendation is that Merit Award does not exceed 1%"
            End If
End If

If Target.Value > 0 Then
            If Target.DisplayFormat.Interior.Color = 13551615 Then
            msg = vbCrLf & vbCrLf & "Low Comp Ratio: Individuals Comp Ratio is below 80%. Consideration should be given to providing a higher increase for this individual"
            End If
End If


'   Check value in column 22
    If Cells(Target.Row, 22).Value = "0 - Too new to rate" Then
        msg = msg & vbCrLf & vbCrLf & "Too New To Rate: This employee has not had a formal Performance Appraisal for FY23. Please ensure that the performance is still factored into your merit decision."
    End If

'   See if any message to return
    If msg <> "" Then MsgBox msg, Title:="Potential Issues to Address"

End Sub

 

[Joe4]

OK, sounds like you have things working the way you need now, so are in no longer in need of assistance here.
Is that correct?