Re: Spelling Error Fequency

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

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.

--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.

Jezebel wrote:
> Answered that on in the other branch of this thread .... :)
>
>
>
>
> "Greg Maxey" <gmaxey@xxxxxxxxxxxxxxxxxxx> wrote in message
> news:uQEHtK0NFHA.3788@xxxxxxxxxxxxxxxxxxxxxxx
>> 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.
>> --
>> Greg Maxey/Word MVP
>> See:
>> http://gregmaxey.mvps.org/word_tips.htm
>> For some helpful tips using Word.
>>
>> Jezebel wrote:
>>> 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" <gmaxey@xxxxxxxxxxxxxxxxxxx> wrote in message
>>> news:uUPa8ayNFHA.2392@xxxxxxxxxxxxxxxxxxxxxxx
>>>> 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
>>>>
>>>>
>>>>
>>>>
>>>>
>>>> --
>>>> Greg Maxey/Word MVP
>>>> See:
>>>> http://gregmaxey.mvps.org/word_tips.htm
>>>> For some helpful tips using Word.


.

Relevant Pages

  • Re: No Class or High Class
    ... Dim oCol As Collection ... For Each oSpError In ActiveDocument.Range.SpellingErrors ... Dim oError As clsError ...
    (microsoft.public.word.vba.general)
  • Re: Spelling Error Fequency
    ... 'Public Property Let Name ... Dim oSpErrors As ProofreadingErrors ... If oError Is Nothing Then ...
    (microsoft.public.word.vba.general)
  • No Class or High Class
    ... Class modules are still a mystery to me. ... Dim oCol As Collection ... For Each oSpError In ActiveDocument.Range.SpellingErrors ... Dim oError As clsError ...
    (microsoft.public.word.vba.general)
  • Re: Spelling Error Fequency
    ... Public Property Get Nameas string ... > Dim colErrors As Collection ... > Dim oError As clsError ... > Dim oSpErrors As ProofreadingErrors ...
    (microsoft.public.word.vba.general)
  • Re: Spelling Error Fequency
    ... > Public Property Get Nameas string ... >> Dim colErrors As Collection ... >> Dim oError As clsError ... >> Dim oSpErrors As ProofreadingErrors ...
    (microsoft.public.word.vba.general)