Excel - All unique words in a range

Question

Perhaps I\'m trying to do too much, but I have a column filled with text. Each cell has an arbitrary number of words, so for example:

     |         A                


        

Answer 1

This option uses 1 loop instead of 3, I like to use a dictionary instead or Collection.

Sub Sample()
Dim varValues As Variant
Dim strAllValues As String
Dim i As Long
Dim d As Object

'Create empty Dictionary
Set d = CreateObject("Scripting.Dictionary")

'Create String With all possible Values
strAllValues = Join(Application.Transpose(Range("A1", Range("A" & Rows.Count).End(xlUp))), " ")

'Split All Values by space into array
varValues = Split(strAllValues, " ")

'Fill dictionary with all values (this filters out duplicates)
For i = LBound(varValues) To UBound(varValues)
    d(varValues(i)) = 1
Next i

'Write All The values back to your worksheet
Range("B1:B" & d.Count) = Application.Transpose(d.Keys)
End Sub

Answer 2

Give this small macro a try:

Sub dural()
    Dim N As Long, U As Long, L As Long
    N = Cells(Rows.Count, "A").End(xlUp).Row
    Dim st As String
    For I = 1 To N
        st = st & " " & Cells(I, 1)
    Next I
    st = Application.WorksheetFunction.Trim(st)
    ary = Split(st, " ")
    U = UBound(ary)
    L = LBound(ary)
    Dim c As Collection
    Set c = New Collection
    On Error Resume Next
    For I = L To U
        c.Add ary(I), CStr(ary(I))
    Next I
    For I = 1 To c.Count
        Cells(I, 2).Value = c.Item(I)
    Next I
End Sub