Hi

try

Code:
Sub kTest()
    
    Dim k, ColA As Object, ColB As Object, i As Long
    
    k = Intersect(ActiveSheet.UsedRange, Range("a:b"))
    
    Set ColA = CreateObject("scripting.dictionary")
    Set ColB = CreateObject("scripting.dictionary")
    
    For i = 2 To UBound(k, 1)
        If Len(k(i, 1)) Then ColA.Item(k(i, 1)) = Empty
        If Len(k(i, 2)) Then ColB.Item(k(i, 2)) = Empty
    Next
    For i = 2 To UBound(k, 1)
        If Len(k(i, 1)) Then
            If ColB.exists(k(i, 1)) Then ColB.Remove k(i, 1)
        End If
        If Len(k(i, 2)) Then
            If ColA.exists(k(i, 2)) Then ColA.Remove k(i, 2)
        End If
    Next
    
    With Range("d2")
        .Offset(-1).Resize(, 2) = [{"Result B compare with A","Result A compare with B"}]
        .Resize(ColB.Count) = Application.Transpose(ColB.keys)
        .Offset(, 1).Resize(ColA.Count) = Application.Transpose(ColA.keys)
    End With
    
End Sub
HTH