how to Use IF statement and Highlight & Message Box Pop up

[fluffyvampirekitten]

Cross Ref:


how to Use IF statement and Highlight & Message Box Pop up

I really need to convert these to vba codes urgently
I would like to highlight certain data (ID) and pop out a message based on the following IF statement
I have two Workbook - Book 1 and Book 2
I need to check the ID ( Book1 - Column S) against ( Book 2 - Column J) and execute IF statement
If (ID is found) ,
if (Book 2 - Remarks Column"P") = Open A/R OR Merged Then
Highlight "Blue"
Message pop out "Confirm Delete?"
else
Highlight "Green"
Else (ID is not found)
Highlight "Red"
Any ways to solve this ?
Thanks in advance
Need it urgently

 

[Stubble Kid]

I've revised the previous code (see the code panel below) to take into account the new requirements:

(a) The code assumes PatientMerge is open, and checks to find it, otherwise the user gets a message.

(b) The code also assumes a file with the words 'Similar Patients Report' is open, and checks to find it, and gives the user a message to proceed or not. The code will use the first file found, so if a user has more than one version open it may use the wrong one (users will have to cancel the validation and then ensure only the one required report file is open before re-running it).

(c) The code now checks cols S and T for a valid ID match and carries out the coloring logic as before. I've completely revised this area of code and assumed that a valid ID could be in col S OR in col T and that either match is okay. Using the loop For Each rng In Wkb1.ActiveSheet.UsedRange.Columns("S:T").Cells as you suggest could have confused the logic of the original code: for example it could validate an ID in col S and color it green, but not validate the ID in col T and color it red and therefore confuse the user with the results. Instead, I've looped each row (rather than individual cells) and validated cols S and T one after the other (using a countif function to check each in turn before using the Vlookup to test the matching cols, etc).


Please test the revisions and let me know if any further changes are needed, or feel free to adapt it as needed.

Option Explicit
Private Sub CheckIDs()
On Error Resume Next
    Dim rng As Range
    Dim Wkb1, Wkb2 As Workbook
    Dim str, str2, sDeleteRng As String
    
    ' find open PatientMerge file...
    str = ""
    For Each Wkb2 In Workbooks
        If Wkb2.Name = "PatientMerge" Then str = Wkb2.Name: Exit For
    Next Wkb2
    If str = "" Then
        MsgBox "The Patient Merge file needs to be open to check the patient IDs." & vbCrLf & vbCrLf & _
                "Please locate and open the file and then re-run this check.", _
                vbInformation Or vbOKOnly, _
                "Patient Merge File Needed"
        Exit Sub
    End If
    ' find first open SimPat file...
    str = ""
    For Each Wkb1 In Workbooks
        If InStr(Wkb1.Name, "Similar Patients Report") > 0 Then str = Wkb1.Name: Exit For
    Next Wkb1
    If str = "" Then
        MsgBox "An open 'Similar Patients Report' file could not be found" & vbCrLf & vbCrLf & _
                "Please locate and open the required 'Similar Patients Report' file to be validated, and then re-run this check.", _
                vbInformation Or vbOKOnly, _
                "Similar Patients Report File Needed"
        Exit Sub
    Else
        If MsgBox("The file below will be validated against the Patient Merge file." & vbCrLf & vbCrLf & _
                    "[ " & str & " ]" & vbCrLf & vbCrLf & _
                    "Click 'OK' to proceed, or 'Cancel' to stop the validation", _
                    vbQuestion Or vbOKCancel Or vbDefaultButton2, _
                    "Ready to Proceed?") = vbCancel Then Exit Sub
    End If
    Wkb1.Activate
    Wkb1.Worksheets("SimPat").Activate
    Wkb1.ActiveSheet.UsedRange.Columns("S:T").Interior.Pattern = xlNone
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Rows
        str = "": str2 = ""
        ' check col S for ID match...
        If WorksheetFunction.CountIf(Wkb2.ActiveSheet.UsedRange.Columns("J"), rng.Columns("S").Value) > 0 Then
            ' ID matched in col S...
            str = WorksheetFunction.VLookup(rng.Columns("S").Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
            str2 = WorksheetFunction.VLookup(rng.Columns("S").Value, Wkb2.ActiveSheet.UsedRange.Columns("J:N"), 5, False) 'reject column
            If str = "Open A/R" Or str = "Merged" Or str2 = "2" Then
                rng.Columns("S").Interior.Color = RGB(0, 0, 255) ' blue
                sDeleteRng = sDeleteRng & "," & rng.Columns("S").Address
            Else
                rng.Columns("S").Interior.Color = RGB(0, 255, 0) ' green
            End If
            
        ' check col T for ID match...
        ElseIf WorksheetFunction.CountIf(Wkb2.ActiveSheet.UsedRange.Columns("J"), rng.Columns("T").Value) > 0 Then
            ' ID matched in col S...
            str = WorksheetFunction.VLookup(rng.Columns("T").Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
            str2 = WorksheetFunction.VLookup(rng.Columns("T").Value, Wkb2.ActiveSheet.UsedRange.Columns("J:N"), 5, False) 'reject column
            If str = "Open A/R" Or str = "Merged" Or str2 = "2" Then
                rng.Columns("T").Interior.Color = RGB(0, 0, 255) ' blue
                sDeleteRng = sDeleteRng & "," & rng.Columns("T").Address
            Else
                rng.Columns("T").Interior.Color = RGB(0, 255, 0) ' green
            End If
                              
        Else ' no ID found...
            rng.Columns("S:T").Interior.Color = RGB(255, 0, 0) ' red
        End If
    Next rng
    
    Wkb1.ActiveSheet.Copy ' make duplicate worksheet
    If sDeleteRng <> "" Then ' delete Blue rows...
        Application.DisplayAlerts = False
        Wkb1.ActiveSheet.Range(Mid(sDeleteRng, 2)).EntireRow.Delete
        Application.DisplayAlerts = True
    End If
    MsgBox "The validation has been completed.", vbInformation, "Finished"
    
End Sub

 

[fluffyvampirekitten]

THANK YOU SOOOOO MUCH!! Finally working .