I get your logic now - essentially 2 comparisons are required and an array constructed from the comparisons. If you wanted to just construct a unique list in an array you could use Scripting Dictionary and Keys however your request is different. Try this
Sub compList()
Dim newList, a, x As Long, fnd As Boolean
ReDim newList(x)
With Range("A1")
a = .CurrentRegion
End With
x = 0
For k = 1 To UBound(a)
For t = 1 To UBound(a)
If a(k, 1) = a(t, 2) Then
fnd = True
Exit For
End If
Next
If fnd = False Then
ReDim Preserve newList(x)
newList(x) = a(k, 1)
x = x + 1
End If
fnd = False
Next
For k = 1 To UBound(a)
For t = 1 To UBound(a)
If a(k, 2) = a(t, 1) Then
fnd = True
Exit For
End If
Next
If fnd = False Then
ReDim Preserve newList(x)
newList(x) = a(k, 2)
x = x + 1
End If
fnd = False
Next
For k = LBound(newList) To UBound(newList)
Range("C" & k + 1) = newList(k)
Next
End Sub
See attachment for example.
Bookmarks