Hello DeeDee,
This is a very basic macro that will extract all the words within
range, and list the words and the number of occurances. Periods at th
end of words are removed and spaces are not counted.
'========================================
Sub ListWordsAndCounts(ByRef WordRng As Range, ByRef ListRng As Range)
Dim Cell As Range
Dim DSO As Object
Dim Items As Variant
Dim Keys As Variant
Dim N As Long
Dim W As Variant
Dim Words As Variant
Set DSO = CreateObject("Scripting.Dictionary")
DSO.CompareMode = 1 'Text Compare
For Each Cell In WordRng
Words = Split(Cell, " ", , vbTextCompare)
For Each W In Words
W = Trim(W)
If Right(W, 1) = "." Then W = Left(W, Len(W) - 1)
If W <> "" Then
If Not DSO.Exists(W) Then
DSO.Add W, 1
Else
N = DSO.Item(W)
DSO.Item(W) = N + 1
End If
End If
Next W
Next Cell
Items = DSO.Items
Keys = DSO.Keys
Set ListRng = ListRng.Resize(UBound(Keys), 2)
For R = 1 To UBound(Keys) + 1
ListRng.Cells(R, 1) = Keys(N)
ListRng.Cells(R, 2) = Items(N)
N = N + 1
Next R
Set DSO = Nothing
End Sub
'========================================
Example of usage:
This will examine all the words in all the cells in the range "A1:16
of the active sheet. A list of the words and their counts will be copie
to "Sheet2" starting at cell "A1"
ListWordsAndCounts Range("A1:A16"), Range("Sheet2!$A$1")
Sincreely,
Leith Ros
