VBA remove matching first & last names across 2 worksheets - string

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

Answer 1

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

Answer 2

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