Extracting SpellingErrors in a loop

[Seatonian]

Hello, I am a raw beginner and this is my first post. I often have to correct students' assignments. I am constructing a macro to scan a one-page document and to (1) turn all the Spelling Errors red, (2) Collect the Spelling Errors and display in a table, along with (3) the FIRST Spelling Suggestion.
The macro fails at step (2): some Errors appear twice; some not at all. I can find no information on how the Collection of Errors is structured and MS Help - er - doesn't.
The Coding is shown below - very clunky. I'd also welcome any help in smartening it up a little.


Sub New_SpellCheck_EXPERIMENT()
' New_SpellCheck_EXPERIMENT Macro
' CALL with ALT + E (for Experiment)
Dim sugList As SpellingSuggestions
Dim sug As SpellingSuggestion ' Could delete all instances of this variable ????
Dim strSugList As String
Dim Blunder, mistake As Variant
Dim eCount As Integer 'May be deleted later.
Dim oRow As Row 'Delete these two Table variables on amalgamation.
Dim oCell As Cell
For Each Blunder In ActiveDocument.SpellingErrors
Blunder.Font.Color = wdColorRed
eCount = eCount + 1
Next Blunder
MsgBox "There are " & eCount & " Errors in this text."
ActiveDocument.Select
With Selection
.EndKey unit:=wdStory
.Collapse 0
.TypeParagraph
.TypeParagraph
End With
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=eCount + 3, _
NumColumns:=5, DefaultTableBehavior:=wdWord9TableBehavior, _
AutoFitBehavior:=AutofitContent
With Selection.Tables(1)
If Style <> "Table Grid" Then
Style = "Table Grid"
End If
.AutoFormat Format:=wdTableFormatGrid3
End With
With Selection
.Tables(1).Rows.Alignment = wdAlignRowCenter
With .Tables(1)
.Range.Font.Size = 14
'Code below populates Column Headers in Row 1.
.Cell(1, 1).Range.Text = " ERROR "
.Cell(1, 2).Range.Text = " CORRECTION "
.Cell(1, 3).Range.Text = " WRITE HERE "
.Cell(1, 4).Range.Text = " WRITE HERE "
.Cell(1, 5).Range.Text = " WRITE HERE "
End With
End With
ActiveDocument.ActiveWindow.View.TableGridlines = True
MsgBox "Is this table grid OK? "
MsgBox "eCount is still = " & eCount

All of the above code works perfectly
The for each next loop below does not catch all errors. Every second error is missing, but the loop iterates the correct number of times, displaying some errors & their corrections twice in the table.



eCount = 0
For Each mistake In ActiveDocument.SpellingErrors
Set sugList = GetSpellingSuggestions(Word:=mistake)
If sugList.Count = 0 Then
strSugList = "No suggestion"
Else
strSugList = sugList(1) 'Only the first suggestion is needed.
End If
eCount = eCount + 1
'Column 2 is printed before Col.1 to prevent GetSpellingSuggestions
'from reading Col.1 and REALLY fouling up the table.
With ActiveDocument.Tables(1)
.Cell(eCount + 1, 2).Range.Select
Selection.TypeText strSugList
Selection.Collapse 0
.Cell(eCount + 1, 1).Range.Select
Selection.TypeText mistake
Selection.Collapse 0
End With
'MsgBox "eCount is = " & eCount & " after this iteration."
Next mistake
End Sub

[gmaxey]

Something like this perhaps:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oError As Range, oRng As Word.Range
Dim lngIndex As Long
Dim arrErrors() As String
Dim oTbl As Word.Table
For Each oError In ActiveDocument.SpellingErrors
With oError
.Font.Color = wdColorRed
ReDim Preserve arrErrors(1, lngIndex)
arrErrors(0, lngIndex) = oError
On Error Resume Next
arrErrors(1, lngIndex) = oError.GetSpellingSuggestions.Item(1)
If Err.Number <> 0 Then
arrErrors(1, lngIndex) = "No suggestion"
End If
On Error GoTo 0
lngIndex = lngIndex + 1
End With
Next oError
ActiveDocument.Range.InsertAfter vbCr
Set oRng = ActiveDocument.Range
With oRng
.Collapse wdCollapseEnd
Set oTbl = .Tables.Add(oRng, UBound(arrErrors, 2) + 2, 5)
With oTbl
.Rows.Alignment = wdAlignRowCenter
.Range.Font.Size = 14
.Cell(1, 1).Range.Text = "ERROR"
Cell(1, 2).Range.Text = "CORRECTION"
.Cell(1, 3).Range.Text = "WRITE HERE"
.Cell(1, 4).Range.Text = "WRITE HERE"
.Cell(1, 5).Range.Text = "WRITE HERE"
For lngIndex = 0 To UBound(arrErrors, 2)
.Cell(lngIndex + 2, 1).Range.Text = arrErrors(0, lngIndex)
.Cell(lngIndex + 2, 2).Range.Text = arrErrors(1, lngIndex)
Next lngIndex
End With
End With
End Sub

[Seatonian]

Thank you Greg for your prompt reply. Your code is extremely sophisticated & I shall learn a lot by studying it. Sadly that in itself creates a problem because I understand it so little that it may be difficult to customise further when needed. One problem that I HAVE managed to solve myself concerns table gridlines as they can be neither Previewed nor Printed. So a Style must be added to the Table's definition. As I say, this I have done.
I hope you'll forgive my saying that I had hoped in this first post to learn the flaw in my own thinking and to get my own macro working as I am familiar with its conventional techniques. I wanted a skateboard, but you have very generously given me a shiny new sports car - which I can't drive.. Sincere thanks all the same.
Seatonian.

[gmaxey]

The fundamental flaw in your code is this line:

'Selection.TypeText mistake

You are in a loop evaluating spelling errors and by using that line you are introducing additonal errors in the collection. Not knowing what to do the collection pukes.

Step through my code using the F8 key. It basically creates a two dimensional array. Loads the error in one demension and the suggestion in the other. When all that is done it then adds the table and populates it with the values in the array.

Good luck.

[macropod]

Not knowing what to do the collection pukes.
Gotta love these technical terms ...

[Seatonian]

Thank you Greg. That was just what I needed. I couldn't work out what your code was doing, but you have given me the tools to do so. I forgot to say that your macro works perfectly and that I have succeeded in adding a few refinements. Two final questions: How can I add two blank rows to the bottom of the table? And how do I indicate to this website that we have achieved, in this thread, a satisfactory result to my problem. (Thanks also to Paul Edstein for his wry comment.)
Best wishes and renewed thanks,
Seatonian.

[gmaxey]

See code below. I think there is something in the "Thread Tools"menu that you can use to mark the thread answered.



Sub ScratchMacro()
'Declare all the variables.
Dim oError As Range, oRng As Word.Range
Dim lngIndex As Long
Dim arrErrors() As String
Dim oTbl As Word.Table
'Loop through the spelling errors
For Each oError In ActiveDocument.SpellingErrors
With oError
'Color the range red.
.Font.Color = wdColorRed
'The declared array variable was never dimensioned. So we can now re-dimension it at each step in the loop to add another
'place for each error. Preserve is used to preserve previous data loaded in the array.
ReDim Preserve arrErrors(1, lngIndex)
'Store the spelling error in the 0, 0 spot. The second 0 is 0 on the first loop because lngIndex is 0.
arrErrors(0, lngIndex) = oError
'No suggestion will generate and error. If so skip it and add a default script.
On Error Resume Next
'Store the suggestion in the 1, 0 spot.
arrErrors(1, lngIndex) = oError.GetSpellingSuggestions.Item(1)
If Err.Number <> 0 Then
arrErrors(1, lngIndex) = "No suggestion"
End If
On Error GoTo 0
'Uptick the index for the next error.
lngIndex = lngIndex + 1
End With
Next oError
'You should see now that we have all the information about the errors that we wanted without affecting the document (adding more errors.)
ActiveDocument.Range.InsertAfter vbCr
Set oRng = ActiveDocument.Range
With oRng
.Collapse wdCollapseEnd
'If you want two empty rows. That is two more than the header row you already need plus a row for each error then modify this line.
'Set oTbl = .Tables.Add(oRng, UBound(arrErrors, 2) + 2, 5)
'Ubound tells you how many data nodes (I'm not that sure of the technical term) the array has with the first node indexed at zero. In this case we
'are interested in the second dimension. So if you document contained 10 spelling errors, Ubound will return 9 (0-9) so for the number of rows you,
'you need 9 + 4) 1 for the tenth error, 1 for the heading and 2 empty.
Set oTbl = .Tables.Add(oRng, UBound(arrErrors, 2) + 4, 5)
With oTbl
.Rows.Alignment = wdAlignRowCenter
.Range.Font.Size = 14
.Cell(1, 1).Range.Text = "ERROR"
.Cell(1, 2).Range.Text = "CORRECTION"
.Cell(1, 3).Range.Text = "WRITE HERE"
.Cell(1, 4).Range.Text = "WRITE HERE"
.Cell(1, 5).Range.Text = "WRITE HERE"
For lngIndex = 0 To UBound(arrErrors, 2)
.Cell(lngIndex + 2, 1).Range.Text = arrErrors(0, lngIndex)
.Cell(lngIndex + 2, 2).Range.Text = arrErrors(1, lngIndex)
Next lngIndex
End With
End With
End Sub

[Seatonian]

Hello again Greg, Almost missed your last post with its splendid commentary. I have studied it carefully (and checked on the Array features you have used) and the light is beginning to dawn. The confusion that remains is in the many 'subscripts' (or should they be called Arguments?) that Arrays demand, and just WHERE items are stored when two different numbering systems are in use: 1 - 10 and 0 - 9 for 10 errors. Work continues!
I am extremely grateful for your Commentary and all the assistance you have so generously given. My OP problem is well solved. A bientôt !
Seatonian.