Finding most common words in excel

[Joshyd]

Hi there,

I have several survey question responses. Many of them are paragraphs in single cells. I am wondering if there is a way for excel to look at every word (not just the cell as a whole) and return the most common words.

The problem I am running into is that I want to look at each word, which may be many in a single cell as opposed to the whole cell value. This is because essentially all the cells are unique values. I am not yet sure how many top words I would need (depends on the results). If any suggestions included an easy way to modify the number of words returned, that would be awesome.

Many thanks in advance.

 

[Fluff]

Which cells contain your paragraphs?

 

[Joshyd]

There are a lot of them, D2:BY60, but I would like to do the search by column.

 

[Fluff]

Ok, how about this

Sub Joshyd()
    Dim Ary As Variant, Sp As Variant, Elmt As Variant
    Dim r As Long, c As Long
    
    Ary = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("D2:BY60").Value2
    With CreateObject("scripting.dictionary")
        For c = 1 To UBound(Ary, 2)
            For r = 1 To UBound(Ary)
                For Each Elmt In Split(Ary(r, c))
                    .Item(Elmt) = .Item(Elmt) + 1
                Next Elmt
            Next r
            If .Count > 0 Then Sheets("[COLOR=#ff0000]Sheet2[/COLOR]").Cells(2, c * 2 - 1).Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
            .RemoveAll
        Next c
    End With
End Sub

Change sheet names to suit.
The 2nd sheet (sheet2 in the code) is where it will output the results

 

[DanteAmor]

Try this, The result on the same sheet in the columns CA y CBCheck the result and you can order the number of words from highest to lowest.

Sub Finding_most_common_words()
  Dim c As Range, w As Variant, dict As Object
  Set dict = CreateObject("scripting.dictionary")
  For Each c In Range("D2:BY60")
    For Each w In Split(c, " ")
      dict(w) = Val(dict(w)) + 1
    Next
  Next
  Range("CA2").Resize(dict.Count) = Application.Transpose(dict.Keys)
  Range("CB2").Resize(dict.Count) = Application.Transpose(dict.Items)
End Sub

 

[Joshyd]

Thank you @Fluff and @DanteAmor, I was able to get it working with your code!

 

[Fluff]

Glad you were able to sort it & thanks for the feedback

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.