Comparing two columns in two different open worksheets

[Suryaprakash]

Sometime back, I had posted a request on the above subject but there was a mistake in the same, as a result of which I did not receive any reply. I am posting the corrected thread again and request the member to help me out with my problem.

I have two files, of which File1.xls is a master file and the other one is File2.xls. File1.xls has 3 columns. Column B is titled "names" and there are 300 names. File2.xls has columns A:P, with column D titled "names" having 5000 names and these 5000 names also contain the above 300 names of File1. I wish to compare column B of File1.xls with column D of File2.xls and wherever the names are matching in the File2, I seek one of the following options:

1. Color the matching names in File2.
2. Mention True or False against each name in File2. A new column may have to be inserted for this purpose.
3. Delete rows containing nonmatching names in File2.

My ultimate purpose is to extract data for all matching names, 300 in all, and make a new file with this data. With any of the above 2 options, I can sort out the required information. Third option gives the new file itself. Any option would be welcome. Could someone provide me a code for this purpose, since I have to manually do this tiresome task once every day.

Both files will be open. I am using Excel 2000. Both files contain only one sheet.

 

[taurean]

Open Master excel file. Open Visual Basic Editor window by pressing ALT + F11. Then choose Insert >> Module. A module with name Module1 will be inserted. Paste the following code:

Public Sub IdentifyMatches()
Dim wbMaster As Workbook, wbCompare As Workbook
Dim lLastRow As Long, lLastRow2 As Long
Set wbMaster = ThisWorkbook
Set wbCompare = Workbooks("File2.xls") '<---Change the second workbook name here!
lLastRow = wbMaster.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
'Finding the rows that match with master
For i = 2 To lLastRow
With wbCompare.Sheets(1)
    lLastRow2 = .Range("D" & Rows.Count).End(xlUp).Row
    For j = 2 To lLastRow2
        If .Range("D" & j).Value = wbMaster.Sheets(1).Range("B" & i) Then
        .Range("A" & j).Resize(, 16).Interior.Color = vbGreen
        End If
    Next j
End With
Next i
 
'Deleting non-matching rows
'In case if you do not want to delete the rows then delete the code below
With wbCompare.Sheets(1) 'Starts here
    For i = lLastRow2 To 2 Step -1
        If .Range("A" & i).Interior.Color <> vbGreen Then .Rows(i).Delete
    Next i
End With 'Ends here
End Sub

This code will perform Step 1 and 3 (Step 2 is useful if you want to do it manually). So first create backup file for File2 and then run this Macro.

 

[Suryaprakash]

Hi Shrivallabha

Your code is absolutely fine and would be of immense help to me. Sorry, I could not test it earlier as I was away for a few days. If I wish to directly delete the nonmatching rows, then which lines in the code be disabled? I need a help regarding looping of files, for which I am posting a new thread.

Thanks once again for your help.

Regards

 

[taurean]

Glad that it works. The current coding will delete non-matching rows. What I meant to say above was:
in case, if you don't want to perform step 3 then you will have to remove the deletion routine. In such case, the code will reduce to:

Public Sub IdentifyMatches()
Dim wbMaster As Workbook, wbCompare As Workbook
Dim lLastRow As Long, lLastRow2 As Long
Set wbMaster = ThisWorkbook
Set wbCompare = Workbooks("File2.xls") '<---Change the second workbook name here!
lLastRow = wbMaster.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
'Finding the rows that match with master
For i = 2 To lLastRow
With wbCompare.Sheets(1)
    lLastRow2 = .Range("D" & Rows.Count).End(xlUp).Row
    For j = 2 To lLastRow2
        If .Range("D" & j).Value = wbMaster.Sheets(1).Range("B" & i) Then
        .Range("A" & j).Resize(, 16).Interior.Color = vbGreen
        End If
    Next j
End With
Next i
End Sub

Currently leave the code as it is (post #2).

 

[Suryaprakash]

Hi Shrivallabha

Thanks for your reply. I am sorry I did not make myself clear. Your code is absolutely fine but I wanted to disable (by putting quote marks) the coloring part of the code, since I am mainly interested in matching rows, and after deletion of nonmatching rows, I am getting my results. The original full code is of course useful in my other tasks where I dont have to delete the nonmatching rows of data. Why I wanted to do away with coloring in the present case was that it takes some time and ultimately I had to remove the filling to work on the data. I hope I am now clear.

Thanks once again for your help.

Regards

 

[taurean]

OK. I understood. Wihout coloring cells this code will delete the rows:

Public Sub IdentifyMatches()
Dim wbMaster As Workbook, wbCompare As Workbook
Dim lLastRow As Long, lLastRow2 As Long
Dim rDntDelete As Range
Set wbMaster = ThisWorkbook
Set wbCompare = Workbooks("File2.xls") '<-Change the second workbook name here!
lLastRow = wbMaster.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
'Finding the rows that match with master
Set rDntDelete = wbCompare.Sheets(1).Range("A" & 1).Resize(, 16)
For i = 2 To lLastRow
With wbCompare.Sheets(1)
    lLastRow2 = .Range("D" & Rows.Count).End(xlUp).Row
    For j = 2 To lLastRow2
        If .Range("D" & j).Value = wbMaster.Sheets(1).Range("B" & i) Then
        Set rDntDelete = Union(rDntDelete, .Range("A" & i).Resize(, 16))
        End If
    Next j
End With
Next i
 
'Deleting non-matching rows
With wbCompare.Sheets(1)
    For i = lLastRow2 To 2 Step -1
        If Intersect(.Range("A" & i).Resize(, 16), rDntDelete) Is Nothing Then .Rows(i).Delete
    Next i
End With
End Sub

 

[Suryaprakash]

Hi

Just for your academic interest, I would like to inform you that your latest code (to delete without coloring) gave very strange results. The number of rows I got was exactly same as what I would get with "Color and Delete", however, there were almost 40% nonmatching rows which were retained.

However, your original code is working fine for my purpose.

Thanks.

 

[taurean]

The code needed a bit of alteration (and thanks for the beep). Here is the revised one. Now it shall work fine .

Public Sub IdentifyMatches()
Dim wbMaster As Workbook, wbCompare As Workbook
Dim lLastRow As Long, lLastRow2 As Long
Dim rDntDelete As Range
Set wbMaster = ThisWorkbook
Set wbCompare = Workbooks("File2.xls") '<-Change the second workbook name here!
lLastRow = wbMaster.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
lLastRow2 = wbCompare.Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
'Finding the rows that match with master
Set rDntDelete = wbCompare.Sheets(1).Range("A" & 1).Resize(, 16)
For i = 2 To lLastRow
With wbCompare.Sheets(1)
    For j = 2 To lLastRow2
        If .Range("D" & j).Value = wbMaster.Sheets(1).Range("B" & i) Then
        Set rDntDelete = Union(rDntDelete, .Range("A" &[COLOR=red] j[/COLOR]).Resize(, 16))
        End If
    Next j
End With
Next i
 
'Deleting non-matching rows
With wbCompare.Sheets(1)
    For i = lLastRow2 To 2 Step -1
        If Intersect(.Range("A" & i).Resize(, 16), rDntDelete) Is Nothing Then .Rows(i).Delete
    Next i
End With
End Sub

 

[Suryaprakash]

Hi Shrivallabha

This latest code is working perfectly fine. Thanks

Regards
Suryaprakash