Search code examples
excelvbamsgbox

Highlight mismatched entries in single dynamic column and present msgbox for entire range


I am new here and relatively new to VBA, so please bear with me. I looked around for an answer to this but couldn't find anything, so I apologize if this has already been answered elsewhere and I didn't find it.

I want to search through a specified column of dynamic length and replace the demographics with a system of numbers (the replace code below works fine, but if you have efficiency-related suggestions, by all means go ahead!). Then what I want to happen is to highlight any entries that do not match the numbers -- these would be strings saying, for example, "Manager" instead of "Boss" or something like that -- and have a message box pop up requesting the user manually code in the highlighted fields.

Currently what is happening is I have Conditional Formatting for any entries that do not match so they get highlighted. My "For Each Cell" populates a message box for each individual entry it finds, but I just want one message box for the entire range. Would it be better to highlight the mismatched entries through VBA? How? How can I code this to only give one message box for the whole range?

Thank you in advance for any help!

Sub ReplaceRaterDemographicCodes()
'Find and replace demographics with their corresponding codes.
Columns("H:H").Select
    With Selection
        .Replace What:="Self", Replacement:="78"
        .Replace What:="Boss", Replacement:="74"
        .Replace What:="Boss 1", Replacement:="74"
        .Replace What:="Peer", Replacement:="75"
        .Replace What:="Direct Report", Replacement:="76"
        .Replace What:="Customer", Replacement:="77"
        .Replace What:="Other", Replacement:="79"
        .Replace What:="Boss 2", Replacement:="72"
        .Replace What:="Boss 3", Replacement:="73"
    End With
    For Each Cell In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row).Select
        If Not Cell.Value = 72 And Not Cell.Value = 73 And _
        Not Cell.Value = 74 And Not Cell.Value = 75 And Not Cell.Value = 76 And _
        Not Cell.Value = 77 And Not Cell.Value = 78 And Not Cell.Value = 79 And _
        Not Cell.Value = "" Then
            MsgBox ("There are uncommon demographics listed. Please modify as needed.")
        End If
    Next Cell
End Sub

Solution

  • Since you don't really need to loop through everything - just until you know that you want to show the message box, you can just exit the for loop after showing the message box:

    Sub ReplaceRaterDemographicCodes()
    ...
    
    For Each Cell In Range("H2:H" & Range("H" & Rows.Count).End(xlUp).Row).Select
        If Not Cell.Value = 72 And Not Cell.Value = 73 And _
        Not Cell.Value = 74 And Not Cell.Value = 75 And Not Cell.Value = 76 And _
        Not Cell.Value = 77 And Not Cell.Value = 78 And Not Cell.Value = 79 And _
        Not Cell.Value = "" Then
            MsgBox ("There are uncommon demographics listed. Please modify as needed.")
            Exit For
        End If
    Next Cell
    End Sub
    

    This way the message box is only shown once and only if it fits your criteria.