The Anchorage
Personal website of Gregory K. Maxey, Commander USN (Retired)
The information, illustrations and code contained in my "Microsoft Word Tips" are provided free and without risk or obligation.
However, the work is mine. If you use it for commercial purposes or benefit from my efforts through income earned or time saved then a donation, however small, will help to ensure the continued availability of this resource.
If you would like to donate, please use the appropriate donate button to access PayPal. Thank you!
This Microsoft Word Help & Microsoft Word Tips page provides a simple yet useful VBA procedure compiling a list of spelling errors.
Spelling errors can be shown marked with a wavy red underline in a Word document. Several users have asked if there was a way to list all of the spelling errors in a document. The macro that follows provides a means to list all misspellings in a document sorted alphabetically or by frequency of the misspelling.
To use the macro you first need to create a Project module and Class module.
Copy the following code into the class module:
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
Copy the following code to the project module:
Sub SpellingErrorReportUsingClassModule() Dim oError As clsError Dim colErrors As Collection Dim oSpErrors As ProofreadingErrors Dim oSpError As Word.Range Dim oSpErrorCnt As Integer Dim uniqueSPErrors As Integer Dim bolSortByFreq As Boolean Dim j As Integer 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 Set oError = colErrors(oSpError.Text) On Error GoTo 0 If oError Is Nothing Then Set oError = New clsError oError.Name = oSpError.Text colErrors.Add oError, oError.Name End If oError.Count = oError.Count + 1 Set oError = Nothing Next 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 With oRng .Move .InsertBreak wdSectionBreakNextPage .Select End With With Selection .ParagraphFormat.TabStops.ClearAll For Each oError In colErrors .TypeText Text:=oError.Name & vbTab & oError.Count & vbCrLf Next .Sections(1).Range.Select .ConvertToTable .Collapse wdCollapseStart End With Set oTbl = Selection.Tables(1) With oTbl .Rows.Add BeforeRow:=Selection.Rows(1) .Cell(1, 1).Range.InsertBefore "Spelling Error" .Cell(1, 2).Range.InsertBefore "Number of Occurrences" .Columns(2).Select End With Selection.ParagraphFormat.Alignment = wdAlignParagraphRight Selection.Collapse wdCollapseStart With oTbl .Rows(1).Shading.BackgroundPatternColor = wdColorGray20 .Columns(1).PreferredWidth = InchesToPoints(4.75) .Columns(2).PreferredWidth = InchesToPoints(1.9) .Rows.Add .Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Summary" .Cell(oTbl.Rows.Count, 2).Range.InsertBefore "Total" .Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorGray20 .Rows.Add .Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Unique Misspellings" .Cell(oTbl.Rows.Count, 2).Range.InsertBefore Trim(Str(uniqueSPErrors)) .Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorAutomatic .Rows.Add .Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Total Number of Spelling Errors" .Cell(oTbl.Rows.Count, 2).Range.InsertBefore Trim(Str(oSpErrorCnt)) End With Selection.HomeKey wdStory lbl_Exit: Exit Sub End Sub
See: Installing Macros for instructions on how to set up and use the macros provided in this Microsoft Word Help & Microsoft Word Tips page.
Here is a small sample of text with some rather obvious spelling errors.
When you run the macro, a message box is displayed asking you if you want to display the results in frequency order (default) or alphabetically.
The result is displayed in a table appended section at the end of the document. Here is a screen shot of the results generated for the sample text above
That's it! I hope you have found this tips page useful and informative. You can download the demonstration document used to create this tips page here: Spelling Error Report
The information, illustrations and code contained in my "Microsoft Word Tips" are provided free and without risk or obligation.
However, the work is mine. If you use it for commercial purposes or benefit from my efforts through income earned or time saved then a donation, however small, will help to ensure the continued availability of this resource.
If you would like to donate, please use the appropriate donate button to access PayPal. Thank you!