Hi all

I am running the code below to draw out the commonly used words and 2-word, 3-word (etc) phrases in one column of a large spreadsheet.

However, I have just realised that this ignores numbers so, for example '1st place' or '300 people' wouldn't appear in the resulting lists.

Can someone advise me what change I need to make to the code to ensure it captures numbers and alpha-numeric combinations.

Thanks

G

Sub Test()
PhraseDensity 1, "h"
PhraseDensity 2, "k"
PhraseDensity 3, "n"
PhraseDensity 4, "q"
PhraseDensity 5, "t"
End Sub

Sub PhraseDensity(nWds As Long, Col As Variant)
Dim astr() As String
Dim i As Long
Dim j As Long
Dim cell As Range
Dim sPair As String
Dim rOut As Range

With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For Each cell In Range("e1", Cells(Rows.Count, "e").End(xlUp))
astr = Split(Letters(cell.Value), " ")

For i = 0 To UBound(astr) - nWds + 1
sPair = vbNullString
For j = i To i + nWds - 1
sPair = sPair & astr(j) & " "
Next j
sPair = Left(sPair, Len(sPair) - 1)

If Not .exists(sPair) Then
.Add sPair, 1
Else
.Item(sPair) = .Item(sPair) + 1
End If
Next i
Next cell

Set rOut = Columns(Col).Resize(.Count, 2).Offset(1).Cells
rOut.EntireColumn.ClearContents

rOut.Columns(1).Value = Application.Transpose(.Keys)
rOut.Columns(2).Value = Application.Transpose(.Items)

rOut.Sort Key1:=rOut(1, 2), Order1:=xlDescending, _
Key2:=rOut(1, 1), Order1:=xlAscending, _
MatchCase:=False, Orientation:=xlTopToBottom, Header:=xlNo
rOut.EntireColumn.AutoFit
End With
End Sub

Function Letters(s As String) As String
Dim i As Long

For i = 1 To Len(s)
Select Case Mid(s, i, 1)
Case "A" To "Z", "a" To "z", "'"
Letters = Letters & Mid(s, i, 1)
Case Else
Letters = Letters & " "
End Select
Next i
Letters = WorksheetFunction.Trim(Letters)
End Function




Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub