Extract unique distinct list from two columns

Question

So I am trying to create a combined list from two separate columns by omitting the duplicate items. I have searched and found a formula that combines the list this way by going through one column at a time.

But I want to combine the columns like this:

where it goes through each row first.

Is there a formula or VBA code that does that? Thank you.

EDIT: This is just a way to show my request. The color was added to show how the combined list is sorted, it is not part of the request. The actual lists are each about 500 rows long consisting of 9+ digit ID numbers.

What about combining the two lists into one column, then using the ["Remove Duplicates"](https://support.office.com/en-us/article/Filter-for-unique-values-or-remove-duplicate-values-ccf664b0-81d6-449b-bbe1-8daaec1e83c2) function that's built into Excel? Then, if the formatting goes away, just use a conditional fomatting to say "if x is in List 1, color Green, else Orange". What have you tried? — BruceWayne, Nov 02 '16 at 18:57
I actually just added the color to highlight how the combined list was sorted as a visual aid, it is not part of the request. And combining the list into one column and removing duplicates results in the first result. — J. Baker, Nov 02 '16 at 19:19
As @BruceWayne mentioned you can do this with the remove duplicates function. If you really want to use VBA go ahead and append the columns together and use something like `ActiveSheet.Range("$M$2:$M$100").RemoveDuplicates Columns:=1, Header:=xlYes`. — J_Lard, Nov 02 '16 at 19:34

Scott Craner · Answer 1 · 2016-11-02T19:56:37.517

This will put the unique words in the order you want.

Sub foo()
Dim rng As Range
Dim ws As Worksheet
Dim i&, j&, t&
Dim dict As Object
Dim iArr() As Variant
Dim oarr() As Variant
Dim itm As Variant
Set dict = CreateObject("Scripting.Dictionary")

Set ws = ActiveSheet
With ws
    Set rng = .Range("A:B").Find("*", .Range("A1"), , , , xlPrevious)
    If Not rng Is Nothing Then
        iArr = .Range(.Cells(2, 1), .Cells(rng.Row, 2)).Value
        For i = LBound(iArr, 1) To UBound(iArr, 1)
            For j = LBound(iArr, 2) To UBound(iArr, 2)
                If iArr(i, j) <> "" Then
                    On Error Resume Next
                    dict.Add iArr(i, j), iArr(i, j)
                    On Error GoTo 0
                End If
            Next j
        Next i
    End If

    'If your dataset is not that large <30,000, then you can use it directly with transpose
    .Range("C2").Resize(dict.Count) = Application.Transpose(dict.items)
    'If your data is large then you will want to put it in a one dimensional array first
    'just uncomment the below and comment the one line above
'    ReDim oarr(1 To dict.Count, 1 To 1)
'    t = 1
'    For Each itm In dict.keys
'        oarr(t, 1) = dict(itm)
'        t = t + 1
'    Next itm
'    Range("C2").Resize(dict.Count) = oarr
End With
End Sub

score 1 · Answer 2 · answered Nov 02 '16 at 20:34

UDF solution. Using your provided sample data, put this formula in cell I2 and copy down =UnqList(ROW(I1),$G$2:$H$6) or =UnqList(ROW(I1),$G$2:$G$6,$H$2:$H$6) (it can be either because the two or more lists might not be next to each other and the UDF accounts for that)

Public Function UnqList(ByVal lIndex As Long, ParamArray rLists() As Variant) As Variant

    Dim i As Long, j As Long
    Dim vList As Variant
    Dim cUnq As Collection
    Dim lMaxRow As Long, lMaxCol As Long

    If lIndex <= 0 Then
        UnqList = CVErr(xlErrRef)
        Exit Function
    End If

    For Each vList In rLists
        If TypeName(vList) <> "Range" Then
            UnqList = CVErr(xlErrRef)
            Exit Function
        Else
            If vList.Rows.Count > lMaxRow Then lMaxRow = vList.Rows.Count
            If vList.Columns.Count > lMaxCol Then lMaxCol = vList.Columns.Count
        End If
    Next vList

    Set cUnq = New Collection

    For i = 1 To lMaxRow
        For j = 1 To lMaxCol
            For Each vList In rLists
                If i <= vList.Rows.Count And j <= vList.Columns.Count Then
                    On Error Resume Next
                    cUnq.Add vList.Cells(i, j).Value, CStr(vList.Cells(i, j).Value)
                    On Error GoTo 0
                    If lIndex = cUnq.Count Then
                        UnqList = cUnq(cUnq.Count)
                        Set cUnq = Nothing
                        Exit Function
                    End If
                End If
            Next vList
        Next j
    Next i

    UnqList = CVErr(xlErrRef)
    Set cUnq = Nothing

End Function

score 1 · Answer 3 · answered Nov 03 '16 at 08:48

You can use my Duplicate Master addin available via my profile.

Advantages are that the addin provides options to

ignore capitilisation
ignore whitespace
run RegExp replacements (advanced)
further options for deletinf, highlighting, selecting duplicates etc

Extract unique distinct list from two columns

3 Answers3