Comparar duas colunas, células clara duplicados

Chapeleiro :

Eu estou tentando comparar duas colunas (A e B) para duplicatas. Como uma saída Eu estou tentando obter células que não correspondem (não duplica). valores de uma coluna são provenientes da tabela 1 e os valores B Coluna são provenientes da tabela 2. alvo Código é, basicamente, para conhecer quais itens foram excluídos da tabela 2 (Coluna B).

Os dados se parece com:

A           B
BMW         PORSCHE
FIAT        VOLVO
VOLVO       AUDI
PORSCHE     FERRARI
FERRARI     TOYOTA
TOYOTA
AUDI 

Saída deve ser:

A           B
BMW
FIAT

Esse é um trabalho para destacar duplicatas, mas como obter valores apagados que são duplicatas? Por exemplo, utilizando .ClearContents. Então, depois que eu tenho loop para excluir linhas vazias no intervalo.

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

Estudante de Gary:

Tentar dar um presente:

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

Nota corremos o loop até inferior .