VBA – Unique List of Data That Appears At Least Once in All Columns – Excel Macro

Use this VBA code to extract a unique list of items that appear inside of multi-column data. The criteria is that the data needs to appear at least once in each column. This one has user friendly interface to run on any size data and get the results wherever user picks in the worksheet.

Sub UniqueListMatchingMultipleColumns()

Dim rng As Range
Dim srcrng As Range

Set rng = Range("g1")

Set srcrng = Application.InputBox("Please select you data (Do not include column headings!)", , , Type:=8)
Set rng = Application.InputBox("Click the cell where you'd like the output to start rendering (a single cell):", , Type:=8)

longstr = "||||"
finalstring = "||||"
For Each i In srcrng

If InStr(longstr, "||||" & i.Value & "||||") = 0 Then

    longstr = longstr & i.Value & "||||"
End If

Next i

For Each word In Split(Mid(longstr, 5, Len(longstr) - 8), "||||")
    n = 1
    got = 0
    For Each col In srcrng.Columns
        mt = Application.Match(word, srcrng.Columns(n), 0)
        If IsNumeric(mt) Then
            got = 1
        Else

            got = 0
            Exit For
        End If

        n = n + 1
    Next col

    If got = 1 Then
        finalstring = finalstring & word & "||||"

    End If

Next word
r = 0
For Each finalword In Split(Mid(finalstring, 5, Len(longstr) - 8), "||||")
    rng.Offset(r, 0).Value = finalword
    r = r + 1
Next finalword

End Sub

Posted by Excel Instructor:
http://www.chicagocomputerclasses.com/excel-classes/