Compare two columns, Clear duplicate cells - excel

Question

I am trying to compare two columns (A and B) for duplicates. As an output I am trying to get cells that does not match (not duplicates). Column A values are coming from table 1 and Column B values are coming from table 2. Code target is basically to get to know which items were deleted from table 2 (Column B).
Data looks like:
A B
BMW PORSCHE
FIAT VOLVO
VOLVO AUDI
PORSCHE FERRARI
FERRARI TOYOTA
TOYOTA
AUDI
Output should be:
A B
BMW
FIAT
This is working for highlighting duplicates, but how to get values deleted that are duplicates? For example using .ClearContents. Then after that I have loop for deleting empty rows in range.
Sub MarkDuplicatesInCompare()
Dim ws As Worksheet
Dim cell As Range
Dim myrng As Range
Dim clr As Long
Dim lastCell As Range
Dim EntireRow As Range
Set ws = ThisWorkbook.Sheets("Compare")
Set myrng = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Rows.Count, "B").End(xlUp))
With myrng
Set lastCell = .Cells(.Cells.Count)
End With
myrng.Interior.ColorIndex = xlNone
clr = 3
For Each cell In myrng
If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Address = cell.Address Then
cell.Interior.ColorIndex = clr
clr = clr
Else
cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastCell).Interior.ColorIndex
End If
End If
Next
' Delete empty rows
For I = myrng.Rows.Count To 1 Step -1
Set EntireRow = myrng.Cells(I, 1).EntireRow
If Application.WorksheetFunction.CountA(EntireRow) = 0 Then
EntireRow.Delete
End If
Next
End Sub

Answer 1

Give this a try:
Sub Keanup()
Dim i As Long, j As Long, Na As Long, Nb As Long
Na = Cells(Rows.Count, "A").End(xlUp).Row
Nb = Cells(Rows.Count, "B").End(xlUp).Row
For i = Na To 1 Step -1
v = Cells(i, "A").Value
For j = Nb To 1 Step -1
If v = Cells(j, "B").Value Then
Cells(i, "A").Delete shift:=xlUp
Cells(j, "B").Delete shift:=xlUp
Exit For
End If
Next j
Next i
End Sub
Note we run the loops bottom up.

Answer 2

you could use AutoFilter()
With Range("A1", Cells(Rows.Count, 1).End(xlUp))
.Rows(1).EntireRow.Insert ' insert temporary row for dummy headers
With .Offset(-1).Resize(.Rows.Count + 1)
.Range("A1:B1").Value = Array("h1", "h2") ' write dummy headers
.AutoFilter field:=1, Criteria1:=Application.Transpose(Range("B1", Cells(Rows.Count, 2).End(xlUp)).Value), Operator:=xlFilterValues
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).ClearContents
.Parent.AutoFilterMode = False
.Rows(1).EntireRow.Delete ' remove dummy headers temporary row
End With
End With
Range("B1", Cells(Rows.Count, 2).End(xlUp)).ClearContents ' clear column B values
or with Find()
Dim cel As Range
With Range("B1", Cells(Rows.Count, 2).End(xlUp))
For Each cel In Range("A1", Cells(Rows.Count, 1).End(xlUp))
If Not .Find(what:=cel.Value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then cel.ClearContents
Next
.ClearContents
End With
which, should keeping "surivors" at the top be an issue, becomes:
Dim cel As Range, s As String
With Range("B1", Cells(Rows.Count, 2).End(xlUp))
For Each cel In Range("A1", Cells(Rows.Count, 1).End(xlUp))
If Not .Find(what:=cel.Value, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then s = s & cel.Address(False, False) & " "
Next
.ClearContents
End With
If s <> vbNullString Then Range(Replace(Trim(s), " ", ",")).Delete xlUp