VBA remove matching first & last names across 2 worksheets

Question

I need help modifying this code to match First and Last names across 2 worksheets, then remove matches from the Sub sheet. At the moment it only matches 2 columns across 1 sheet. Specifics:

How do i change this code so Names on 'Sheet 1' Column 'B' are Matched to names on 'sheet 2' column 'E' & all matches are deleted from 'Sheet 1". Same is repeated for 'Sheet 1' Column 'C' to 'Sheet 2' Column 'F'.

Sub CompareNames()

Dim rngDel As Range
Dim rngFound As Range
Dim varWord As Variant
Dim strFirst As String

With Sheets("ADULT Sign On Sheet")
    For Each varWord In Application.Transpose(.Range("A1", .Cells(.Rows.Count,"A").End(xlUp)).Value)
        If Len(varWord) > 0 Then
            Set rngFound = .Columns("B").Find(varWord, .Cells(.Rows.Count, "B"), xlValues, xlPart)
            If Not rngFound Is Nothing Then
                strFirst = rngFound.Address
                Do
                    If Not rngDel Is Nothing Then Set rngDel = Union(rngDel, rngFound) Else Set rngDel = rngFound
                    Set rngFound = .Columns("B").Find(varWord, rngFound, xlValues, xlPart)
                Loop While rngFound.Address <> strFirst
            End If
        End If
    Next varWord
End With

If Not rngDel Is Nothing Then rngDel.Delete

Set rngDel = Nothing
Set rngFound = Nothing

End Sub

please reformat your question so its more readable and clear. — , Nov 24 '14 at 08:45
do you get an error? unexpected behaviour? what is wrong with your current code? — , Nov 24 '14 at 09:07
The first paragraph of my description says what i want it to do and what it currently does. I don't know how to code it to do what i want it to do. Thanks — Bradley Jones, Nov 24 '14 at 09:29

Chrismas007 · Accepted Answer · 2014-11-26T13:38:11.573

Loops through all values in Sheet1 Column B. If that value is found in Sheet2 Column E, the entire row in Sheet1 is deleted. Then it loops through all values in Sheet1 Column C. If that value is found in Sheet2 Column F, the entire row in Sheet1 is deleted.

Sub DeleteCopy()

Dim LastRow As Long
Dim CurRow As Long
Dim DestLast As Long

LastRow = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row
DestLast = Sheets("Sheet2").Range("E" & Rows.Count).End(xlUp).Row

For CurRow = 2 To LastRow 'Assumes your first row of data is in row 2
    If Not Sheets("Sheet2").Range("E2:E" & DestLast).Find(Sheets("Sheet1").Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
        Sheets("Sheet1").Range("B" & CurRow).Value = ""
    Else
    End If
Next CurRow

LastRow = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
DestLast = Sheets("Sheet2").Range("F" & Rows.Count).End(xlUp).Row

For CurRow = 2 To LastRow 'Assumes your first row of data is in row 2
    If Not Sheets("Sheet2").Range("F2:F" & DestLast).Find(Sheets("Sheet1").Range("C" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
        Sheets("Sheet1").Range("C" & CurRow).Value = ""
    Else
    End If
Next CurRow

End Sub

This is great, can you possible make it so it only clears the contents of the cells with the match? not shift them up or clear the entire row, as i have alot of headings and other data all through that sheet. — Bradley Jones, Nov 25 '14 at 05:12

score 0 · Answer 2 · answered Nov 24 '14 at 18:52

Try this, you will have to call it twice once with the first criteria and then again with the second critiera

I think I have it set up properly for the first criteria

Sub DeleteIfMatchFound()
Dim SearchValues As Variant
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim sLR As Long, tLR As Long, i As Long

Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsTarget = ThisWorkbook.Worksheets("Sheet2")

          sLR = wsSource.Range("B" & wsSource.Rows.Count).End(xlUp).Row
          tLR = wsTarget.Range("E" & wsSource.Rows.Count).End(xlUp).Row
   SearchValues = wsSource.Range("B2:B" & sLR).Value

     For i = 1 To (tLR - 1)
            If Not IsError(Application.match(SearchValues(i, 1), wsTarget.Range("E2:E" & tLR), 0)) Then
                wsTarget.Rows(i + 1).Delete
            End If
    Next i
End Sub

The code seems to be deleting the entire row instead of just clearing the cell with the match. After clearing 5 or so rows i am receiving a subscript error "subscript out of range" at this line: If Not IsError(Application.match(SearchValues(i, 1), wsTarget.Range("E2:E" & tLR), 0)) Then wsTarget.Rows(i + 1).Delete — Bradley Jones, Nov 25 '14 at 03:59
To run this you'd have to work backwards through the `For Next` loop `(tLR - 1) to 1 Step -1` but also see my question on my answer above. — Chrismas007, Nov 25 '14 at 16:06

VBA remove matching first & last names across 2 worksheets

2 Answers2

Linked