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]

The code below should be a good start to the solution. It assume both workbooks are open and the active sheets are the ones to be cross-checked. It also assumes column S contains IDs from row 1 onwards (ie there are no headings in the data). You will have to pride the appropriate workbook names.

It is not clear from your request what is meant to happen if the "confirm delete" is answered yes or no (at the moment the code below does nothing other than coloring the cell blue).

Sub CheckIDs()


    On Error Resume Next
    Dim rng As Range, str As String
    Dim Wkb1, Wkb2 As Workbook
    
    Set Wkb1 = Workbooks("Book1") ' replace with name of open workbook 1
    Set Wkb2 = Workbooks("Book2") ' replace with name of open workbook 2
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Column("S").Cells
        str = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
        If Err.Description = "" Then ' ID found...
                If str = "Open A/R OR Merged" Then
                    rng.Interior.Color = RGB(0, 0, 255) ' blue
                    Select Case MsgBox("Confirm delete?", vbYesNo)
                        Case vbYes
                        ' what to do here????
                    
                        Case vbNo
                        ' what to do here???


                    End Select
                Else
                    rng.Interior.Color = RGB(0, 255, 0) ' green
                End If
        Else ' no ID found...
            Err.Clear
            rng.Interior.Color = RGB(255, 0, 0) ' red
        End If
    Next rng


End Sub

 

[fluffyvampirekitten]

The code below should be a good start to the solution. It assume both workbooks are open and the active sheets are the ones to be cross-checked. It also assumes column S contains IDs from row 1 onwards (ie there are no headings in the data). You will have to pride the appropriate workbook names.

It is not clear from your request what is meant to happen if the "confirm delete" is answered yes or no (at the moment the code below does nothing other than coloring the cell blue).

Sub CheckIDs()


    On Error Resume Next
    Dim rng As Range, str As String
    Dim Wkb1, Wkb2 As Workbook
    
    Set Wkb1 = Workbooks("Book1") ' replace with name of open workbook 1
    Set Wkb2 = Workbooks("Book2") ' replace with name of open workbook 2
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Column("S").Cells
        str = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
        If Err.Description = "" Then ' ID found...
                If str = "Open A/R OR Merged" Then
                    rng.Interior.Color = RGB(0, 0, 255) ' blue
                    Select Case MsgBox("Confirm delete?", vbYesNo)
                        Case vbYes
                        ' what to do here????
                        [COLOR=#ff0000]Delete row in Book 1 (ID row) 
                        [/COLOR]
                        Case vbNo
                        ' what to do here???
                        [COLOR=#ff0000] continue the loop till all the ids are check[/COLOR]

                    End Select
                Else
                    rng.Interior.Color = RGB(0, 255, 0) ' green
                End If
        Else ' no ID found...
            Err.Clear
            rng.Interior.Color = RGB(255, 0, 0) ' red
        End If
    Next rng


End Sub

I hope this makes sense to you. I'm not familiar with the loops and conditions T^T
Since book1 is dynamic, do i need to count the max num of rows ? To find the row with ID ?

 

[fluffyvampirekitten]

The code below should be a good start to the solution. It assume both workbooks are open and the active sheets are the ones to be cross-checked. It also assumes column S contains IDs from row 1 onwards (ie there are no headings in the data). You will have to pride the appropriate workbook names.

It is not clear from your request what is meant to happen if the "confirm delete" is answered yes or no (at the moment the code below does nothing other than coloring the cell blue).

Sub CheckIDs()


    On Error Resume Next
    Dim rng As Range, str As String
    Dim Wkb1, Wkb2 As Workbook
    
    Set Wkb1 = Workbooks("Book1") ' replace with name of open workbook 1
    Set Wkb2 = Workbooks("Book2") ' replace with name of open workbook 2
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Column("S").Cells
        str = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
        If Err.Description = "" Then ' ID found...
                If str = "Open A/R OR Merged" Then
                    rng.Interior.Color = RGB(0, 0, 255) ' blue

                    Select Case MsgBox("Confirm delete?", vbYesNo)
                        Case vbYes
                        ' what to do here????
                    
                        Case vbNo
                        ' what to do here???


                    End Select
                Else
                    rng.Interior.Color = RGB(0, 255, 0) ' green
                End If
        Else ' no ID found...
            Err.Clear
            rng.Interior.Color = RGB(255, 0, 0) ' red
        End If
    Next rng


End Sub

the highlight part is done in book1 right ?
book1 is SimpatTest100
book2 is PatientMerge
i tested your codes but it doesnt work
i commented out the delete part to test ur codes

 

[fluffyvampirekitten]

Okay I deleted the message box because it kept prompting .
New problem again ,
Since I deleted the message box , I want to copy the worksheet to a new worksheet in book1 after all the highlight part is done .
Then , delete all the "BLUE" rows

I would like to add a new condition,
-Check ID again as usual
-Check the Reject column("N"), if the value is 2 , delete the row(Book1)



The code can work now .

Private Sub CheckIDs()
On Error Resume Next
    Dim rng As Range, str As String
    Dim Wkb1, Wkb2 As Workbook
    Dim lastRow, lastColumn As Long
    Dim str2 As String
    Set Wkb1 = Workbooks("SimpatTest100") ' replace with name of open workbook 1
    Set Wkb2 = Workbooks("PatientMerge") ' replace with name of open workbook 2
    
    Workbooks("SimpatTest100").Worksheets("SimPat").Activate
    
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Columns("S").Cells
        str = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
        str2 = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:N"), 5, False) 'reject column
                
        If Err.Description = "" Then ' ID found...
                If str = "Open A/R" Or "Merged" Then
                    rng.Interior.Color = RGB(0, 0, 255) ' blue
                Else
                    rng.Interior.Color = RGB(0, 255, 0) ' green
                End If
                              
        Else ' no ID found...
            Err.Clear
            rng.Interior.Color = RGB(255, 0, 0) ' red
        End If
    Next rng
 

End Sub

 

[Stubble Kid]

Try the revised code below:

This does the additional check on column N at the same time as the check on column P and highlights cells blue. To keep track of which rows are highlighted blue, I've added a new variable (sDeleteRng) to record the matching cells to be deleted. There are now additional lines to copy the checked worksheet and then delete the Blue highlighted rows (using sDeleteRng - this is easier than eg programming to filter by color, etc).

I've inserted a line near the beginning to clear all the colored cells in column S, assuming you want to run the code several times.

The code will look at the "used range" in the workbooks, so if the data expands down the rows the code should cope and automatically find the last row.

Obviously without seeing and working with your data I cannot test the code.

Private Sub CheckIDs()
On Error Resume Next
    Dim rng As Range, str As String
    Dim Wkb1, Wkb2 As Workbook
    Dim str2, sDeleteRng As String
    Set Wkb1 = Workbooks("SimpatTest100") ' replace with name of open workbook 1
    Set Wkb2 = Workbooks("PatientMerge") ' replace with name of open workbook 2
    
    Workbooks("SimpatTest100").Worksheets("SimPat").Activate
    Wkb1.ActiveSheet.UsedRange.Columns("S").Interior.Pattern = xlNone
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Columns("S").Cells
        str = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
        str2 = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:N"), 5, False) 'reject column
                
        If Err.Description = "" Then ' ID found...
                If str = "Open A/R" Or str = "Merged" Or str2 = "2" Then
                    rng.Interior.Color = RGB(0, 0, 255) ' blue
                    sDeleteRng = sDeleteRng & "," & rng.Address
                Else
                    rng.Interior.Color = RGB(0, 255, 0) ' green
                End If
                              
        Else ' no ID found...
            Err.Clear
            rng.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
    
End Sub

 

[fluffyvampirekitten]

Can i ask is there any way to not set the workbook1 cos it varies..
Its a generated report so it will have dates behind the file name.

 

[Stubble Kid]

The code can be adapted to automatically find workbook1, rather than manually amending the code everytime. But, we need to establish some "rules" to find it.

First, where will this code be kept? In Wkb1 or Wkb2 or somewhere else?

Although Wkb1 name varies with a date descriptor, does eg the first part of the name remain the same?

Will Wkb1 always be open when the code is run?

If the code has to find the file and open it, is it always in the same directory? Is Wkb1 filed in the same folder as other dated Wkb1 files? How could be tell the latest one?

 

[fluffyvampirekitten]

The code can be adapted to automatically find workbook1, rather than manually amending the code everytime. But, we need to establish some "rules" to find it.

First, where will this code be kept? In Wkb1 or Wkb2 or somewhere else?
The code will be kept in another Workbook.
User have to install this "Add-Ins" - "SimPat Macro.xlam"
thus it will displayed in the Ribbon toolbar.

Although Wkb1 name varies with a date descriptor, does eg the first part of the name remain the same?
Yes , the first part of the name remain the same - Similar Patients Report "29062015 to 30062015"

Will Wkb1 always be open when the code is run?
Yes , wkb1 will always be open.

If the code has to find the file and open it, is it always in the same directory? Is Wkb1 filed in the same folder as other dated Wkb1 files? How could be tell the latest one?
Some Users have their own folder but i could ask them to create another folder or save it in their desktop. which way is better?
They could tell the latest one by saving it with the date behind after the whole process.
is it possible to prompt user to type the file name they want after the running the whole macro .
Like, a message box " Completed! then ask user to type the file name ?"

Answers in red. thanks for the help . really appreciated.
I really need to finish this soon T^T ...oh my..

 

[fluffyvampirekitten]

Try the revised code below:

This does the additional check on column N at the same time as the check on column P and highlights cells blue. To keep track of which rows are highlighted blue, I've added a new variable (sDeleteRng) to record the matching cells to be deleted. There are now additional lines to copy the checked worksheet and then delete the Blue highlighted rows (using sDeleteRng - this is easier than eg programming to filter by color, etc).

I've inserted a line near the beginning to clear all the colored cells in column S, assuming you want to run the code several times.

The code will look at the "used range" in the workbooks, so if the data expands down the rows the code should cope and automatically find the last row.

Obviously without seeing and working with your data I cannot test the code.

Private Sub CheckIDs()
On Error Resume Next
    Dim rng As Range, str As String
    Dim Wkb1, Wkb2 As Workbook
    Dim str2, sDeleteRng As String
    Set Wkb1 = Workbooks("SimpatTest100") ' replace with name of open workbook 1
    Set Wkb2 = Workbooks("PatientMerge") ' replace with name of open workbook 2
    
    Workbooks("SimpatTest100").Worksheets("SimPat").Activate
    Wkb1.ActiveSheet.UsedRange.Columns("S").Interior.Pattern = xlNone
    
    For Each rng In Wkb1.ActiveSheet.UsedRange.Columns("S").Cells
        str = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:P"), 7, False)
        str2 = WorksheetFunction.VLookup(rng.Value, Wkb2.ActiveSheet.UsedRange.Columns("J:N"), 5, False) 'reject column
                
        If Err.Description = "" Then ' ID found...
                If str = "Open A/R" Or str = "Merged" Or str2 = "2" Then
                    rng.Interior.Color = RGB(0, 0, 255) ' blue
                    sDeleteRng = sDeleteRng & "," & rng.Address
                Else
                    rng.Interior.Color = RGB(0, 255, 0) ' green
                End If
                              
        Else ' no ID found...
            Err.Clear
            rng.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
    
End Sub

I want to change the range ... apply both way to column S and column T

Is this the right way ?

For Each rng In Wkb1.ActiveSheet.UsedRange.Columns("S:T").Cells