Comparing data in two columns on separate sheets if duplicates are found copy entire row.

[Phily50]

Hi all, first post so please be nice!

I am trying to figure this out but am having no luck with it whatsoever. What I am attempting(and failing!) to do is to compare 2 columns in two sheets and if a duplicate is found, copy the whole row to a third sheet.

The data is set up with a list of names on a sheet named "Data" in column Q starting from cell Q2. Then there is a shorter list of names on a sheet called "Targets" starting from cell G3. If any duplicates are found, I want the whole row that the duplicate has been found on in "Data" to be copied to a third sheet called "X-Ref" starting at row 2.

When done I would like a meesage box to pop up to state how many matches have been found(not sure how easy this bit is!)

Anyways, I hope that I have been descriptive enough in my request for help and thanks to all in advance.

 

[Phily50]

Just to add to this post I have this bit of code that I managed to snag from this very forum, but I'm having trouble editing it for my needs.

Sub FindMatches()
    Dim cSN As Range, cFound As Range
    Dim sFirstAddr As String
    With Sheets("Data")
        For Each cSN In .Range("Q2:Q" & .Cells(Rows.Count, "Q").End(xlUp).Row)
            With Sheets("Targets")
                On Error Resume Next
                Set cFound = .Range("G:G").Find(What:=cSN.Value, After:=.Range("G1"), _
                    LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
                If Not cFound Is Nothing Then
                    sFirstAddr = cFound.Address
                    Do Until cFound Is Nothing
                        cFound.EntireRow.Cut Destination:= _
                        Sheets("X-Ref").Cells(Rows.Count, "A").End(xlUp).Offset(1)
                        Set cFound = .Cells.FindNext(After:=cFound)
                        If cFound.Address = sFirstAddr Then
                            Exit Do
                        End If
                    Loop
                End If
                On Error GoTo 0
             End With
        Next cSN
    End With
End Sub

 

[Phily50]

Anyone? sorry to bump but I'm scratching my head here.

Thanks in advance.

 

[Phily50]

Well this has well and truly stumped me. I even tried using a VLOOKUP but it failed to meet my requirements...

 

[Phily50]

 

[VoG]

If I have understood correctly

Sub Dups()
Dim LR As Long, i As Long, n As Long
With Sheets("Data")
    LR = .Range("Q" & Rows.Count).End(xlUp).Row
    For i = 2 To LR
        If IsNumeric(Application.Match(.Range("Q" & i).Value, Sheets("Targets").Columns("G"), 0)) Then
            .Rows(i).Copy Destination:=Sheets("X-Ref").Range("A" & Rows.Count).End(xlUp).Offset(1)
            n = n + 1
        End If
    Next i
End With
MsgBox n & " matches were found", vbInformation, "Completed"
End Sub

 

[Phily50]

Wow, that works perfectly, thanks VoG! So simple and I actually understand what the code is doing (which is saying something for me as I'm sort of learning as I need to with vba).

As an aside, is there anyway to add to this code/write a new macro so I can search a cell for any text contained within another cell?

For example, if cell Q2 in sheet "targets" contained John SMITH and one of the cells in column G of sheet "data" contained SMITH, would there be any way to pick this up?

 

[VoG]

I suggest that you start a new thread for your new question.

 

[Phily50]

Ok. Thanks again for your help.