T4201_Extract Unique In Two Columns Dictionary Split Trick

https://excel-egy.com/forum/t4201
---------------------------------

Sub Extract_Unique_In_Two_Columns_Dictionary_Split_Trick()
    Dim a, x, b(), key, i As Long

    a = Worksheets(1).Range("B5:C" & Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row).Value2

    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(a)
            .item(a(i, 1) & "~" & a(i, 2)) = .item(a(i, 1) & "~" & a(i, 2))
        Next i
        i = 1
        ReDim b(1 To .Count, 1 To 2)

        For Each key In .Keys
            x = Split(key, "~")
            b(i, 1) = x(0)
            b(i, 2) = x(1)
            i = i + 1
        Next key
    End With

    With Worksheets(2)
        .Range("B5").Resize(UBound(b), 2) = b
    End With
End Sub