Sub Senfdsg1()
  Dim vTp1, dic1, dic2, i&, XX
  vTp1 = ActiveSheet.UsedRange
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  i = 2
  Do While Not IsEmpty(vTp1(i, 2))
XX = dic1(vTp1(i, 2)): i = i + 1: If i > UBound(vTp1) Then Exit Do
  Loop
  i = 2
  Do While Not IsEmpty(vTp1(i, 1))
If Not dic1.Exists(vTp1(i, 1)) Then XX = dic2(vTp1(i, 1))
i = i + 1: If i > UBound(vTp1) Then Exit Do
  Loop
If dic2.Count > 0 Then Range("C2").Resize(dic2.Count, 1) = WorksheetFunction.Transpose(dic2.Keys)
End Sub