Spelling Error Fequency

[Greg Maxey]

For those who frequent these NGs regularly you know that I can't spell.
Actually I can spell, but I am careless.

I have been monkeying around with some code that will search a document then
list alphabetically all misspelled words. I am using my budding but limited
knowledge of arrays to sort the list and purge out duplicates so words that
are misspelled more than once are only listed once. It works.

I was thinking it would be helpful to determine and list how many times each
word was misspelled. I think it would be possible, but I am not sure how I
would proceed.

Currently I am comparing each error to the contents of the existing array
and if a match occurs I am skipping that error. This way identical
misspellings the array only contains one instance of the misspelling. I
don't see how I could work a counter into this process.

Maybe if all words where put into the array initially, sorted in then
compare the first to the second and if a match occurs delete the first and
compare the second to the third until a match doesn't occur then jump up one
error and proceed on. This sounds achievable, but I don't know how to do
it.

Any thoughts?

Here is the current code:
Sub printSpellingErrors()
Dim arrSpArray() As String
Dim oSpErrors As ProofreadingErrors
Dim oSpError As Object
Dim i As Integer
Dim oRng As Range

Set oSpErrors = ActiveDocument.Range.SpellingErrors
If oSpErrors.Count = 0 Then
MsgBox "The document contains no spelling errors."
End
End If

ReDim arrSpArray(0)

'Add each error to the array if not a duplicate
For Each oSpError In oSpErrors
'Compare to each exist element in the array
For i = LBound(arrSpArray) To UBound(arrSpArray)
If oSpError = arrSpArray(i) Then
'Skip if already in array
GoTo SkipToNext
End If
Next i
'Otherwise add to array
arrSpArray(UBound(arrSpArray)) = oSpError
'Preserve and resize array for next element
ReDim Preserve arrSpArray(UBound(arrSpArray) + 1)
SkipToNext:
Next oSpError

'Remove last empty element
If UBound(arrSpArray) > 0 Then ReDim Preserve
arrSpArray(UBound(arrSpArray) - 1)

'Pass array to sort
BubbleSort arrSpArray

'Prepare for display
Set oRng = ActiveDocument.Range
oRng.Move
'oRng.Text = vbCr
oRng.InsertBreak wdSectionBreakNextPage
oRng.Move
oRng.Text = "List of Misspelled Words" & vbCr
oRng.Move

i = 0
For i = LBound(arrSpArray) To UBound(arrSpArray)
oRng.Text = arrSpArray(i) & vbCr
oRng.Collapse Direction:=wdCollapseEnd
Next i
'Clip empty paragraph
oRng.Characters.First.Previous.Delete
End Sub
Sub BubbleSort(TempArray As Variant)

Dim Temp As Variant
Dim i As Integer
Dim bolExchange As Integer

Do
bolExchange = False
'Loop through each element in the array.
For i = LBound(TempArray) To UBound(TempArray) - 1
'If element > next element then exchange the two elements.
If LCase(TempArray(i)) > LCase(TempArray(i + 1)) Then
bolExchange = True
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While bolExchange

End Sub

 

[Jezebel]

Instead of using an array, try using a collection. Create an class module
with properties 'Name' and 'Count'. and build a collection of these for the
errors you find.

Dim oError as clsError
Dim colErrors as collection

set colErrors = new collection

For each oSPError in oSpErrors

'Already in the collection?
on error resume next
set oError = colErrors(oSPError.Text)
on error goto 0

'Not in the collection - new error
If oError is nothing then
set oError = New clsError
oError.Name = oSPError.Text
colErrors.Add oError, oError.Name
end if

'Increment the count
oError.Count = oError.Count + 1
set oError = nothing

end if

'List the results
For each oError in colErrors
Debug.Print oError.Name, oError.Count
Next

 

[Greg Maxey]

Jezebel,

I have been off adapting the Word Frequency macro to achieve my objective
and it works great. Thanks for your suggestions. I have never ventured in
the Class module arena and may not be able to follow you directions. I will
give it a shot though.

In the meantime. Here is the code I have adapted:

Sub spErrorFrequency()

Dim SingleSpError As String 'Raw spelling error pulled from doc
Const maxSpErrors = 9000 'Maximum unique spelling errors
allowed
Dim arrSpErrors(maxSpErrors) As String 'Array to hold unique misspelled
words
Dim Freq(maxSpErrors) As Integer 'Frequency counter for unique
misspelled Words
Dim spError As Range 'The spelling error object
Dim spErrorNum As Integer 'Number of unique misspelled words
Dim oSpErrorCnt As Long 'Numbe of total misspelled words
Dim bolSortByFreq As Boolean 'Flag for sorting order
Dim Found As Boolean 'Temporary flag
Dim j As Integer 'Temporary variable
Dim k As Integer 'Temporary variable
Dim l As Integer 'Temporary variable
Dim tempCount As Integer 'Temporary variable
Dim tempString As String
Dim oRng As Range

'Set sort order
bolSortByFreq = True
If MsgBox("The default sort order is error freqeuncy." _
& vbCr & "Do you want to sort errors" _
& " alphabetically instead?", vbYesNo) = vbYes Then
bolSortByFreq = False
End If

Selection.HomeKey Unit:=wdStory
System.Cursor = wdCursorWait
spErrorNum = 0

'Count total errors
oSpErrorCnt = ActiveDocument.Range.SpellingErrors.Count


For Each spError In ActiveDocument.Range.SpellingErrors
SingleSpError = spError
'If Len(SingleSpError) > 0 Then
Found = False
For j = 1 To spErrorNum
If arrSpErrors(j) = SingleSpError Then
Freq(j) = Freq(j) + 1
Found = True
Exit For
End If
Next j
If Not Found Then
spErrorNum = spErrorNum + 1
arrSpErrors(spErrorNum) = SingleSpError
Freq(spErrorNum) = 1
End If
If spErrorNum > maxSpErrors - 1 Then
j = MsgBox("The maximum array size has been exceeded. Increase
maxSpErrors.", vbOKOnly)
Exit For
End If
'End If
Next spError

'Sort
For j = 1 To spErrorNum - 1
k = j
For l = j + 1 To spErrorNum
If (Not bolSortByFreq And arrSpErrors(l) < arrSpErrors(k)) _
Or (bolSortByFreq And Freq(l) > Freq(k)) Then k = l
Next l
If k <> j Then
tempString = arrSpErrors(j)
arrSpErrors(j) = arrSpErrors(k)
arrSpErrors(k) = tempString
tempCount = Freq(j)
Freq(j) = Freq(k)
Freq(k) = tempCount
End If
Next j

'Now write out the results
Set oRng = ActiveDocument.Range
oRng.Move
oRng.InsertBreak wdSectionBreakNextPage
oRng.Select
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
For j = 1 To spErrorNum
.TypeText Text:=arrSpErrors(j) & vbTab & Trim(Str(Freq(j))) & vbCrLf
Next j
End With
Selection.Sections(1).Range.Select
Selection.ConvertToTable
Selection.Collapse wdCollapseStart
ActiveDocument.Tables(1).Rows.Add BeforeRow:=Selection.Rows(1)
ActiveDocument.Tables(1).Cell(1, 1).Range.InsertBefore "Spelling Error"
ActiveDocument.Tables(1).Cell(1, 2).Range.InsertBefore "Number of
Occurrences"
ActiveDocument.Tables(1).Columns(2).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.Collapse wdCollapseStart
ActiveDocument.Tables(1).Rows(1).Shading.BackgroundPatternColor =
wdColorGray20
ActiveDocument.Tables(1).Columns(1).PreferredWidth = InchesToPoints(4.75)
ActiveDocument.Tables(1).Columns(2).PreferredWidth = InchesToPoints(1.9)

ActiveDocument.Tables(1).Rows.Add
ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count,
1).Range.InsertBefore "Summary"
ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count,
2).Range.InsertBefore "Total"
ActiveDocument.Tables(1).Rows(ActiveDocument.Tables(1).Rows.Count).Shading.BackgroundPatternColor
= wdColorGray20

ActiveDocument.Tables(1).Rows.Add
ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count,
1).Range.InsertBefore "Number of Unique Spelling Errors"
ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count,
2).Range.InsertBefore Trim(Str(spErrorNum))
ActiveDocument.Tables(1).Rows(ActiveDocument.Tables(1).Rows.Count).Shading.BackgroundPatternColor
= wdColorAutomatic

ActiveDocument.Tables(1).Rows.Add
ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count,
1).Range.InsertBefore "Number of Spelling Errors"
ActiveDocument.Tables(1).Cell(ActiveDocument.Tables(1).Rows.Count,
2).Range.InsertBefore (oSpErrorCnt)

Selection.HomeKey wdStory

End Sub

 

[Greg Maxey]

Jezebel,

I copied your code into a new macro. I hit a brick wall with:

Create an class module with properties 'Name' and 'Count'.

I don't know how to do that. It is late and I will have to look harder at
this tomorrow.

 

[Jezebel]

Aren't you having fun!

Class modules are very easy. In this case, the entire code for the class
module would be

Option Explicit
Public Name as string
Public Count as long



But if you really want to get your teeth into some interesting coding, the
'sort' section of your code has a lot of possibilities. What you currently
have is a rudimentary bubble sort. Do a Google on sorting and searching
algorithms for some of the other options. QuickSort is fun to code (although
you'd have to be a seriously appalling speller for it to make any
appreciable difference in this case...)

And a collection is yet another option. If you had a collection of class
objects, you could, on completion, add them to a second collection using a
key constructed from the Count property. Then iterate the collection to
retrieve the words in order of frequency: thus a total 2n operations to sort
and output, as opposed to, I think, n + n log (n) using your current method.

 

[Jezebel]

Answered that on in the other branch of this thread ....

 

[Greg Maxey]

Jezebel,

While why it works is still Vodoo magic to me, the following performs
perfectly for what I intended. With acknowledgements to you I may make it
an addition to my Word Tips site. I am going to see if I can figure out how
to avoid the Public declarations in the Class module. I don't know where to
start, but terms like "Get" "Let" "Private" seems to be a place to start
????:

Sub SpellingErrorReportUsingClassModule()
Dim oError As clsError 'clsError is the class module name
'Create a Class Module with the following entries
'Public Name As String
'Public Count As Long
Dim colErrors As Collection
Dim oError As clsError
Dim oSpErrors As ProofreadingErrors
Dim oSpError As Word.Range
Dim oSpErrorCnt As Long 'Number of total misspelled words
Dim spErrorNum As Integer 'Number of unique misspelled words
Dim bolSortByFreq As Boolean 'Flag for sorting order
'Temp Stings for sorting
Dim j As Integer, k As Integer, l As Integer
Dim tempCount As Integer
Dim tempString As String
Dim oRng As Word.Range
Dim oTbl As Table

Set colErrors = New Collection
Set oSpErrors = ActiveDocument.Range.SpellingErrors

'Set sort order
bolSortByFreq = True
If MsgBox("The default sort order is error freqeuncy." _
& vbCr & "Do you want to sort errors" _
& " alphabetically instead?", vbYesNo) = vbYes Then
bolSortByFreq = False
End If

oSpErrorCnt = ActiveDocument.Range.SpellingErrors.Count
spErrorNum = 0

For Each oSpError In oSpErrors
'Already in the collection?
On Error Resume Next
Set oError = colErrors(oSpError.Text)
On Error GoTo 0
'Not in the collection - new error
If oError Is Nothing Then
Set oError = New clsError
oError.Name = oSpError.Text
colErrors.Add oError, oError.Name
spErrorNum = spErrorNum + 1
End If

'Increment the count
oError.Count = oError.Count + 1
Set oError = Nothing
Next

'Sort
Dim j As Integer, k As Integer, l As Integer
Dim tempCount As Integer
Dim tempString As String
For j = 1 To spErrorNum - 1
k = j
For l = j + 1 To spErrorNum
If (Not bolSortByFreq And colErrors(l).Name < colErrors(k).Name) _
Or (bolSortByFreq And colErrors(l).Count > colErrors(k).Count) Then
k = l
Next l
If k <> j Then
tempString = colErrors(j).Name
colErrors(j).Name = colErrors(k).Name
colErrors(k).Name = tempString
tempCount = colErrors(j).Count
colErrors(j).Count = colErrors(k).Count
colErrors(k).Count = tempCount
End If
Next j

'List the results
Set oRng = ActiveDocument.Range
oRng.Move
oRng.InsertBreak wdSectionBreakNextPage
oRng.Select
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
For Each oError In colErrors
.TypeText Text:=oError.Name & vbTab & oError.Count & vbCrLf
Next
End With
Selection.Sections(1).Range.Select
Selection.ConvertToTable
Selection.Collapse wdCollapseStart

Set oTbl = Selection.Tables(1)

oTbl.Rows.Add BeforeRow:=Selection.Rows(1)
oTbl.Cell(1, 1).Range.InsertBefore "Spelling Error"
oTbl.Cell(1, 2).Range.InsertBefore "Number of Occurrences"
oTbl.Columns(2).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.Collapse wdCollapseStart
oTbl.Rows(1).Shading.BackgroundPatternColor = wdColorGray20
oTbl.Columns(1).PreferredWidth = InchesToPoints(4.75)
oTbl.Columns(2).PreferredWidth = InchesToPoints(1.9)

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Summary"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore "Total"
oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorGray20

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Unique Spelling
Errors"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore Trim(Str(spErrorNum))
oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorAutomatic

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Spelling Errors"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore (oSpErrorCnt)

Selection.HomeKey wdStory

End Sub

Thanks.

 

[Jezebel]

Public in a class property declaration means that the property can be
referred to from outside the class. It's not a Bad Thing like global
variables.

The fully-fledged way to provide a property in a class module is with code
like this --

Private mName as string

Public Property Get Name() as string
Name = mName
End Property

Public Property Let Name(NewValue as string)
mName = NewValue
End Property

If you did it exactly like this, it would be functionally identical to
"Public Name as string" -- ie, other functions can read and write the
property at will. The point of the full version is that you can add
additional code, eg to provide a default value, or to validate NewValue
before accepting it, --

Public Property Let Name(NewValue as string)
If len(NewValue) = 0 then
Err.Raise x, "Name cannot be blank"
else
mName = NewValue
end if
End Property

Or you might provide only the Get function, to make the property read-only.

Your class can also have Subs and Functions if you want to give it methods;
and if you really get fancy it can raise events. All the objects in the Word
object model are coded using this same basic set of techniques.

 

[Greg Maxey]

Jezebel,

I used Get and Let only once before in a Userform and my skull nearly
cracked. I am going to try to figure this out using your examples because I
like to catch my own fish.

If I get stuck, I may asked for a fish this time and ask you to demonstrate
in the full code I posted how the Get and Let would work. Thanks.

 

[Greg Maxey]

Jezebel,

The following code seems to be working. I am close to grasping what is
taking place, but sense that I am doing something repetively or unnecessary.
For example this part:

Set colErrors = New Collection
Set oSpErrors = ActiveDocument.Range.SpellingErrors

It seems like ColErrors (a collection of spelling errors) should simply be

Set colErrors = ActiveDocument.Range.SpellingErrors


I would appreciate any comments for improvement.

Sub SpellingErrorReportUsingClassModule()
Dim oError As clsError 'clsError is the class module name
'Create a Class Module named "clsError" with the following entries
'Option Explicit
'Private mName As String
'Private mCount As Long
'Public Property Get Name() As String
' Name = mName
'End Property
'Public Property Let Name(NewValue As String)
' mName = NewValue
'End Property
'Public Property Get Count() As Long
' Count = mCount
'End Property
'Public Property Let Count(NewValue As Long)
' mCount = NewValue
'End Property
Dim colErrors As Collection
Dim oSpErrors As ProofreadingErrors
Dim oSpError As Word.Range
Dim oSpErrorCnt As Long 'Number of total misspelled words
Dim spErrorNum As Integer 'Number of unique misspelled words
Dim bolSortByFreq As Boolean 'Flag for sorting order
'Temp Stings for sorting
Dim j As Integer, k As Integer, l As Integer
Dim tempCount As Integer
Dim tempString As String
Dim oRng As Word.Range
Dim oTbl As Table

Set colErrors = New Collection
Set oSpErrors = ActiveDocument.Range.SpellingErrors

'Set sort order
bolSortByFreq = True
If MsgBox("The default sort order is error freqeuncy." _
& vbCr & "Do you want to sort errors" _
& " alphabetically instead?", vbYesNo) = vbYes Then
bolSortByFreq = False
End If

oSpErrorCnt = ActiveDocument.Range.SpellingErrors.Count
spErrorNum = 0

For Each oSpError In oSpErrors
'Already in the collection?
On Error Resume Next
Set oError = colErrors(oSpError.Text)
On Error GoTo 0
'Not in the collection - new error
If oError Is Nothing Then
Set oError = New clsError
oError.Name = oSpError.Text
colErrors.Add oError, oError.Name
spErrorNum = spErrorNum + 1
End If

'Increment the count
oError.Count = oError.Count + 1
Set oError = Nothing
Next

'Sort
For j = 1 To spErrorNum - 1
k = j
For l = j + 1 To spErrorNum
If (Not bolSortByFreq And colErrors(l).Name < colErrors(k).Name) _
Or (bolSortByFreq And colErrors(l).Count > colErrors(k).Count) Then
k = l
Next l
If k <> j Then
tempString = colErrors(j).Name
colErrors(j).Name = colErrors(k).Name
colErrors(k).Name = tempString
tempCount = colErrors(j).Count
colErrors(j).Count = colErrors(k).Count
colErrors(k).Count = tempCount
End If
Next j

'List the results
Set oRng = ActiveDocument.Range
oRng.Move
oRng.InsertBreak wdSectionBreakNextPage
oRng.Select
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
For Each oError In colErrors
.TypeText Text:=oError.Name & vbTab & oError.Count & vbCrLf
Next
End With
Selection.Sections(1).Range.Select
Selection.ConvertToTable
Selection.Collapse wdCollapseStart

Set oTbl = Selection.Tables(1)

oTbl.Rows.Add BeforeRow:=Selection.Rows(1)
oTbl.Cell(1, 1).Range.InsertBefore "Spelling Error"
oTbl.Cell(1, 2).Range.InsertBefore "Number of Occurrences"
oTbl.Columns(2).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.Collapse wdCollapseStart
oTbl.Rows(1).Shading.BackgroundPatternColor = wdColorGray20
oTbl.Columns(1).PreferredWidth = InchesToPoints(4.75)
oTbl.Columns(2).PreferredWidth = InchesToPoints(1.9)

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Summary"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore "Total"
oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorGray20

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Unique Spelling
Errors"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore Trim(Str(spErrorNum))
oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorAutomatic

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Spelling Errors"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore (oSpErrorCnt)

Selection.HomeKey wdStory

End Sub

 

[Jezebel]

A collection is a bit of automation built in to VB/VBA, for managing sets of
names and things. The 'things' in the collection can be anything. They are
used mostly with objects, but you can put numbers of strings in there just
as easily. Think of them as a kind of free-form array. In fact, you can use
them very much like an array: each member of the collection has a numeric
index, as well as the key you assign when you add the item to the
collection. Look at the Documents() collection, for example. You can
retrieve the docs by number (1 to however many there are open) or by name.


ActiveDocument.Range.SpellingErrors is indeed a collection: of all the
ranges in the document. However the collection you are building contains
your own objects, not document ranges. In your code you are iterating the
collection of error ranges, and from that populating your own -- initially
empty -- collection of error objects.


There's nothing complex about Get and Let: Get just means retrieve the
property from the class object. Let means set the property. There is also
Set, which you use in place of Let if the data type is an object --

Public Property Set MyObject(NewValue as Word.Document)
Set oDoc = NewValue
End Property

 

[Greg Maxey]

Jezebel,

I am trying. I really am.

Say the first spelling error is "tyme." If I step through the code and use
the mouse to view the values.

On Error Resume Next
Set oError = colErrors(oSpError.Text)
On Error GoTo 0

The second line shows:

Set oError = colErrors(oSpError.text) The pop up displays oSpError.Txt =
"tyme"

If I have just set oError to something then I don't follow why the following
line executes as true. If I have just set the oError to something then how
can it still be nothing??

If oError Is Nothing Then

 

[Howard Kaikow]

For sorting, see http://www.standards.com/index.html?Sorting.

NEVER use bubble sort.

 

[Jezebel]

LOL. How else can you prove that other methods are faster?

 

[Jezebel]

oError and oSPError are different things. oSPError is the error in your
document. oError is one of your own class objects.

This line -- Set oError = colErrors(oSpError.Text) -- is trying to retrieve,
from your own collection, an object with the key "tyme". You need the on
error resume next because that statement throws an error if there is no
object in the collection with that key. And if there is no such object,
oError will be nothing.

If you want to watch what's going on in a little more detail, add some debug
code within the loop, to keep track of what's in your collection --

debug.print "Errors found so far: " & colErrors.Count
for i = 1 to colErrors.count
set oError = colErrors(i)
debug.print "Error " & i & ": " & oError.Name & " - " & oError.Count
Next
set oError = nothing

 

[Greg]

Howard,

Is there supposed to be code somewhere on that page for the methode of
sorting that you recommend that I used in place of "Bubble" sort? If
there is, I didn't see any.

 

[Jezebel]

Don't be too concerned about it, Greg. Bubble sort is the worst of methods
in that it uses the highest number of processing steps for the number of
elements to be sorted; on the other hand it is simple and doesn't require a
lot of code. For relatively small lists (such as, one hopes, your list of
spelling errors) it is not as unreasonable a choice as Howard suggests.

 

[Greg Maxey]

Jezebel,

I know the first macro I posted had a Bubble Sort routine but then when I
shifted to to the modified Word Frequency macro then on to your class
suggestion I am using a sort process directly in the code. Is the process
I'm using still considered Bubble sort?

I am a little concerned about the size of the list ;-)

 

[Jezebel]

I'm no longer sure which is the latest version of your routine. Bubble sort
means nested iterations of the array, comparing each item with the next and
swapping their places if they're out of order.

 

[Greg Maxey]

Jezebel.

Here is the lastes version of the code. It appears I am using Bubble Sort.

Sub SpellingErrorReportUsingClassModule()

'Create a Class Module named "clsError" with the following entries
'Option Explicit
'Private mName As String
'Private mCount As Long
'Public Property Get Name() As String
' Name = mName
'End Property
'Public Property Let Name(NewValue As String)
' mName = NewValue
'End Property
'Public Property Get Count() As Long
' Count = mCount
'End Property
'Public Property Let Count(NewValue As Long)
' mCount = NewValue
'End Property

Dim oError As clsError 'clsError is the class module name
'each unique spelling error will be
an
'instance in the class module
Dim colErrors As Collection 'Collection of unique spelling
errors
Dim oSpErrors As ProofreadingErrors
Dim oSpError As Word.Range
Dim oSpErrorCnt As Integer 'Number of total misspelled words
Dim uniqueSPErrors As Integer 'Number of unique misspelled words
Dim bolSortByFreq As Boolean 'Flag for sorting order
Dim j As Integer 'Temp values for sorting
Dim k As Integer
Dim l As Integer
Dim tempCount As Integer
Dim tempString As String
Dim oRng As Word.Range
Dim oTbl As Table

Set colErrors = New Collection
Set oSpErrors = ActiveDocument.Range.SpellingErrors

'Set sort order
bolSortByFreq = True
If MsgBox("The default sort order is error freqeuncy." _
& vbCr & "Do you want to sort errors" _
& " alphabetically instead?", vbYesNo) = vbYes Then
bolSortByFreq = False
End If

For Each oSpError In oSpErrors
On Error Resume Next
'Sets oError to the value of colErrors(Misspelled Word)
'if it already exist in collection
Set oError = colErrors(oSpError.Text)
'If it doesn't exist in colErrors then oError remains set to Nothing
On Error GoTo 0
'Not in the collection then create new Class instance and add error to
colErrors
If oError Is Nothing Then
'Create new Class instance
Set oError = New clsError
'Call Property Let Procedure in Class module and pass value to .Name
property
oError.Name = oSpError.Text
'Add to colError. Calls Propert Get Procedure in Class module to retrieve
..Name value
colErrors.Add oError, oError.Name
End If

'Increment count
oError.Count = oError.Count + 1
Set oError = Nothing
Next

'Sort for Display
For j = 1 To colErrors.Count - 1
k = j
For l = j + 1 To colErrors.Count
If (Not bolSortByFreq And colErrors(l).Name < colErrors(k).Name) _
Or (bolSortByFreq And colErrors(l).Count > colErrors(k).Count) Then
k = l
Next l
If k <> j Then
tempString = colErrors(j).Name
colErrors(j).Name = colErrors(k).Name
colErrors(k).Name = tempString
tempCount = colErrors(j).Count
colErrors(j).Count = colErrors(k).Count
colErrors(k).Count = tempCount
End If
Next j

'Display Results
oSpErrorCnt = ActiveDocument.Range.SpellingErrors.Count
uniqueSPErrors = colErrors.Count

Set oRng = ActiveDocument.Range
oRng.Move
oRng.InsertBreak wdSectionBreakNextPage
oRng.Select
Selection.ParagraphFormat.TabStops.ClearAll
With Selection
For Each oError In colErrors
.TypeText Text:=oError.Name & vbTab & oError.Count & vbCrLf
Next
End With
Selection.Sections(1).Range.Select
Selection.ConvertToTable
Selection.Collapse wdCollapseStart

Set oTbl = Selection.Tables(1)

oTbl.Rows.Add BeforeRow:=Selection.Rows(1)
oTbl.Cell(1, 1).Range.InsertBefore "Spelling Error"
oTbl.Cell(1, 2).Range.InsertBefore "Number of Occurrences"
oTbl.Columns(2).Select
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.Collapse wdCollapseStart
oTbl.Rows(1).Shading.BackgroundPatternColor = wdColorGray20
oTbl.Columns(1).PreferredWidth = InchesToPoints(4.75)
oTbl.Columns(2).PreferredWidth = InchesToPoints(1.9)

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Summary"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore "Total"
oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorGray20

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Unique
Misspellings"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore Trim(Str(uniqueSPErrors))
oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorAutomatic

oTbl.Rows.Add
oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Total Number of Spelling
Errors"
oTbl.Cell(oTbl.Rows.Count, 2).Range.InsertBefore Trim(Str(oSpErrorCnt))

Selection.HomeKey wdStory

End Sub