Creating list of unique words from multiple cells

[marknorton]

Hi

Please help. Not sure if this is possible or not!

I have a list of similar phrases in column A.

For example:

tomato soup
tomato soup heinz
soup heinz
heinz soup
tomato soup heinz 57

Is there a way of Excel pulling a list of unique keywords from all those cells?

So it would end up with a column containing:

tomato
soup
heinz
57

 

[marknorton]

(Sorry I chopped the end of my post off!)

Many thanks in anticipation!
Mark

 

[marknorton]

Not sure why, but I can't see this thread in the forum? Can anyone else see it?

 

[Akuini]

Hi, marknoton
Try this

Sub extractWord()
    Dim strArray() As String
    Dim d As Object, e
    Dim i As Long
    Dim rr As Long
    Dim r As Range
    Dim Rng As Range

    Set d = CreateObject("scripting.dictionary")
    rr = Range("A" & Rows.count).End(xlUp).row
    Set Rng = Range("A1:A" & rr)
      
    For Each r In Rng
     strArray = Split(r, " ")
        For i = LBound(strArray) To UBound(strArray)
            If Not d.Exists(strArray(i)) Then d.Add strArray(i), 1
        Next
    Next

    i = 1
    For Each e In d
    Cells(i, 3) = e
    i = i + 1
    Next
        
End Sub

 

[Peter_SSs]

.. similar idea, but a bit more compact:

Sub MakeList()
  Dim d As Object
  Dim r As Range
  Dim Itm As Variant
  
  Set d = CreateObject("Scripting.Dictionary")
  d.compareMode = 1
  For Each r In Range("A1", Range("A" & Rows.Count).End(xlUp))
    For Each Itm In Split(r.Value)
      d(Itm) = 1
    Next Itm
  Next r
  Range("C1").Resize(d.Count).Value = Application.Transpose(Array(d.keys))
End Sub

 

[Akuini]

Nice code Peter!
I learn something from it. Thanks.

 

[Peter_SSs]

Nice code Peter!
I learn something from it. Thanks.

Cheers.