Finding the most frequently used words/phrases

[Chickon007]

So I was given a database with a little over 600 entries and told to find the most common responses.


First I found the most common words using the method described in this thread:

https://www.mrexcel.com/forum/excel...rds-column-without-specifying-what-words.html

Basically, if you have text in a column like this:[TABLE="width: 500"]
<tbody>[TR]
[TD]Hi, I'm new here.[/TD]
[/TR]
[TR]
[TD]Hi, I've been here.[/TD]
[/TR]
[TR]
[TD]Hi, its Sunday.[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

It would return:[TABLE="width: 500"]
<tbody>[TR]
[TD]Hi - 3[/TD]
[/TR]
[TR]
[TD]here - 2[/TD]
[/TR]
[TR]
[TD]I'm - 1[/TD]
[/TR]
[TR]
[TD]I've - 1[/TD]
[/TR]
</tbody>[/TABLE]

etc. until it has gone through all of the words.

However, I would like it to look not only at individual words but phrases.

So instead of only looking at each word individually, it would also look at and measure the frequency of series of words.

Ex.

Hi
Hi I'm
Hi I'm new

I'm just wondering if there would be a way to do this by modifying the code in the linked spreadsheet (i'll copy and paste it below). I've done some minor stuff with coding macros in Excel and I can usually figure stuff out myself but I was hoping someone more experienced could provide some insight.

Option Explicit


Sub MakeWordList()
Dim InputSheet As Worksheet
Dim WordListSheet As Worksheet
Dim PuncChars As Variant, x As Variant
Dim i As Long, r As Long
Dim txt As String
Dim wordCnt As Long
Dim AllWords As Range
Dim PC As PivotCache
Dim PT As PivotTable

Application.ScreenUpdating = False
Set InputSheet = ActiveSheet
Set WordListSheet = Worksheets.Add(after:=Worksheets(Sheets.Count))
WordListSheet.Range("A1") = "All Words"
WordListSheet.Range("A1").Font.Bold = True
InputSheet.Activate
wordCnt = 2
PuncChars = Array(".", ",", ";", ":", "'", "!", "#", _
"$", "%", "&", "(", ")", " - ", "_", "--", "+", _
"=", "~", "/", "", "{", "}", "[", "]", """", "?", "*")
r = 1


' Loop until blank cell is encountered
Do While Cells(r, 1) <> ""
' covert to UPPERCASE
txt = UCase(Cells(r, 1))
' Remove punctuation
For i = 0 To UBound(PuncChars)
txt = Replace(txt, PuncChars(i), "")
Next i
' Remove excess spaces
txt = WorksheetFunction.Trim(txt)
' Extract the words
x = Split(txt)
For i = 0 To UBound(x)
WordListSheet.Cells(wordCnt, 1) = x(i)
wordCnt = wordCnt + 1
Next i
r = r + 1
Loop

' Create pivot table
WordListSheet.Activate
Set AllWords = Range("A1").CurrentRegion
Set PC = ActiveWorkbook.PivotCaches.Add _
(SourceType:=xlDatabase, _
SourceData:=AllWords)
Set PT = PC.CreatePivotTable _
(TableDestination:=Range("C1"), _
TableName:="PivotTable1")
With PT
.AddDataField .PivotFields("All Words")
.PivotFields("All Words").Orientation = xlRowField
End With
End Sub


Thanks for any advice!

 

[Logit]

This macro will count the number of occurrences of whatever is entered into each cell in Column A.
Presently, it will not break down the phrases like you are seeking"

Hi
Hi I'm
Hi I'm new

But it will give you a count of the entire phrases in the column:

[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD]Hi, I'm new here..........1[/TD]
[/TR]
[TR]
[TD]Hi, I've been here........2[/TD]
[/TR]
[TR]
[TD]Hi, its Sunday.............2[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD]Hi, I've been here.[/TD]
[/TR]
[TR]
[TD]Hi, its Sunday.[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

Option Explicit


Sub Special_Countif()
Dim i, LastRowA, LastRowB
LastRowA = Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Columns("B:C").ClearContents
    For i = 1 To LastRowA
        If Application.CountIf(Range("B:B"), Cells(i, "A")) = 0 Then
            Cells(i, "B").Offset(1, 0).Value = Cells(i, "A").Value
        End If
    Next
        Columns("B:B").Select
        Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        LastRowB = Range("B" & Rows.Count).End(xlUp).Row
        For i = 2 To LastRowB
        Cells(i, "C").Value = Application.CountIf(Range("A:A"), Cells(i, "B"))
    Next i
    Range("B1").Value = "Entry"
    Range("C1").Value = "Occurrences"
    Range("B1:C1").HorizontalAlignment = xlCenter
    Range("B1").Select
    Columns("B:C").AutoFit
    Application.EnableEvents = True
End Sub

Paste the macro into a routine module, put a command button on Sheet 1. Enter terms and phrases in Column A.

Click button.