Delete all misspelled words in Microsoft Word document - vba

Question

I have numerous word documents with misspelt words that I'm hoping to batch delete. I've tried both of the solutions mentioned below, but they all seem to fail for me.
https://answers.microsoft.com/en-us/msoffice/forum/all/how-to-remove-all-misspelled-words-in-ms-word-at/608dbb5d-e719-4b5f-b44e-1b0542b66bd7
Sub DeleteSpellingErrors()
Dim rng As word.Range, i As Integer
If Selection.Range.Start = Selection.Range.End Then
Set rng = ActiveDocument.Content
Else
Set rng = Selection.Range
End If
If rng.SpellingErrors.Count > 0 Then
For i = rng.SpellingErrors.Count To 1 Step -1
rng.SpellingErrors(i).Delete
Next
End If
End Sub
https://answers.microsoft.com/en-us/msoffice/forum/all/remove-all-misspelled-words-in-my-word-document/b686c318-c1fc-4d90-9e56-e922bb556abd
Using these macro codes causes my microsoft word to freeze (I'm using a 10th gen intel i7) indefinitely. Despite having waited for hours, there still hasn't been any progress. It seems to me like these codes only work for shorter documents, but because my word docs have more than 200 pages, it seems to freeze. Does anyone have any other code suggestions? Better yet, does anyone have any suggestions that allow me to batch delete misspelt words across multiple word docs? Currently, I am deleting misspelt words one document at a time. Thanks for any help!

Answer 1

Try if this code snippet is a bit faster:
Sub DeleteSpellingErrors()
Dim cnt As Long
Dim cur As Range
Dim doc As Document
Set doc = ActiveDocument
cnt = doc.Range.SpellingErrors.Count
Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
For i = 1 To cnt
cur.Select
cur.Delete
Debug.Print cnt & " " & i
Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
DoEvents
Next
End Sub
Most probably you will have to re-run the procedure two or three times as I see that SpellingErrors.Count is not exact.
This re-run can be avoided with this other coding:
Sub DeleteSpellingErrors()
Dim cnt, i As Long
Dim cur, Last As Range
Dim doc As Document
Set doc = ActiveDocument
cnt = doc.Range.SpellingErrors.Count
Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
Set Last = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToLast)
i = 1
Do While cur <> Last
cur.Select
cur.Delete
Debug.Print cnt & " " & i
Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
DoEvents
i = i + 1
Loop
End Sub
For testing purposes the document consisted of 107 pages with more than 3000 spelling errors and it took few minutes (about 3 or 4) of execution.
This is another version, that needs just one run to delete all the spelling errors, for Graham Mayor's add-in:
Function DeleteSpellingErrors(doc As Document) As Boolean
Dim cnt, i As Long
Dim cur, Last As Range
If doc Is Nothing Then
Set doc = Application.ActiveDocument
End If
Do
cnt = doc.Range.SpellingErrors.Count
If cnt <= 0 Then Exit Do
Set Last = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToLast)
Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToFirst)
For i = 1 To cnt
cur.Select
cur.Delete
'Debug.Print cnt & " " & i
Set cur = doc.GoTo(What:=wdGoToSpellingError, Which:=wdGoToNext)
DoEvents
i = i + 1
Next
Loop
DeleteSpellingErrors = True
End Function

Answer 2

Your code runs fine on my PC with a document that has 350 spelling errors.
If you have a 200+ page document it would be better to disable screen updating whilst your macro runs. I would also add a 'doevents' statement to the for loop so that at least the CTRL Break will halt the program. Initially you may also want to debug.print the count of errors to see how the macro is progressing.
Option Explicit
Sub DeleteSpellingErrors()
Dim rng As Word.Range
Dim i As Long
If Selection.Range.Start = Selection.Range.End Then
Set rng = ActiveDocument.StoryRanges(wdMainTextStory)
Else
Set rng = Selection.Range
End If
If rng.SpellingErrors.Count > 0 Then
Application.ScreenUpdating = False
Debug.Print "Total errors = ", rng.SpellingErrors.Count ' for debugging only
For i = rng.SpellingErrors.Count To 1 Step -1
DoEvents
rng.SpellingErrors.Item(i).Delete
Debug.Print i, rng.SpellingErrors.Count ' for debug only. Note Count doesn't change
Next
Application.ScreenUpdating = True
Application.ScreenRefresh
End If
End Sub