Compare two lists and copy unique values to the second list

Originally Posted by nilem

Hi Brumbot,
maybe so

Sub ert()
Dim x, i&
With Sheets("RM Input Table")
    x = .Range("C3", .Cells(Rows.Count, 3).End(xlUp)).Value
End With
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        .Item(x(i, 1)) = 1
    Next i
'    MsgBox .Count
    With Sheets("RM Input Table")
        x = .Range("A3", .Cells(Rows.Count, 1).End(xlUp)).Value
    End With
    For i = 1 To UBound(x)
        If .Exists(x(i, 1)) Then .Remove x(i, 1) Else .Item(x(i, 1)) = 1
    Next i
'    MsgBox .Count
    If .Count > 0 Then Sheets("RM Input Table").Cells(Rows.Count, 3).End(xlUp)(2).Resize(.Count).Value _
       = WorksheetFunction.Transpose(.keys)
End With
End Sub

This is great! Other than the fact that if it finds one in the middle of the range that is not included in C, it pastes it with a 1 row gap at the bottom. Is there any way to make it so that it paste without the gap?