Solved: Macro to select first option in words with wavy underlines

[translator_]

Word adds a wavy underline to words that are misspelt. I would like to have a macro that would change those instances with their first suggested correction (the one that would appear with a right click on each misspelt word) unless a particular misspelt word belongs to a specific list of words, in that case, it should not change it and highlight it instead.

[gmaxey]

Something like this:

Option Explicit
Sub ScratchMacro()
'A quick macro scratch pad created by Greg Maxey
Dim oSE As Range
Dim i As Long
Dim arrWordsToSkip() As String
arrWordsToSkip = Split("blarf, kafildafish, salime", ",")
Dim oSC
For Each oSE In ActiveDocument.Range.SpellingErrors
For i = 0 To UBound(arrWordsToSkip)
If oSE.Text = arrWordsToSkip(i) Then
oSE.HighlightColorIndex = wdBrightGreen
GoTo Skip
End If
Next i
Set oSC = oSE.GetSpellingSuggestions
oSE.Text = oSC(1)
Skip:
Next oSE
End Sub

[translator_]

Many thanks Greg. Seems to work, albeit fairly slowly (about 15 secs for a page full of such words). When it encounters a word for which there is no suggestion, I get:

Run-time error '5941'
The requested member of the collection does not exist

When clicking debug it highlights:

oSE.Text = oSC(1)

So, I would say that words that have no suggestion should be highlighted too with a different colour.

[macropod]

Try:
Sub AutoSpellCorrect()
Dim Rng As Range, oSuggestions As Variant, StrExcl As String
StrExcl = ",word1,word2,word3,"
For Each Rng In ActiveDocument.Range.SpellingErrors
If InStr(StrExcl, "," & Rng.Text & ",") = 0 Then
If Rng.GetSpellingSuggestions.Count > 0 Then
Set oSuggestions = Rng.GetSpellingSuggestions
Rng.Text = oSuggestions(1)
Else
Rng.HighlightColorIndex = wdPink
End If
Else
Rng.HighlightColorIndex = wdBrightGreen
End If
Next
End Sub

[translator_]

Many thanks. One small glitch. Apparently when a word is in the dictionary (i.e. no spelling suggestion) and it is in the exception list, it is not highlighted.

Tried with this sample text and macro:

Thie Only comments may mae mie mrt appear after End Sub pase pasto

And may was not highlighted.

Sub AutoSpellCorrect()
Dim Rng As Range, oSuggestions As Variant, StrExcl As String
StrExcl = ",mie,may,mrt,pase,"
For Each Rng In ActiveDocument.Range.SpellingErrors
If InStr(StrExcl, "," & Rng.Text & ",") = 0 Then
If Rng.GetSpellingSuggestions.Count > 0 Then
Set oSuggestions = Rng.GetSpellingSuggestions
Rng.Text = oSuggestions(1)
Else
Rng.HighlightColorIndex = wdPink
End If
Else
Rng.HighlightColorIndex = wdBrightGreen
End If
Next
End Sub

[macropod]

One small glitch. Apparently when a word is in the dictionary (i.e. no spelling suggestion) and it is in the exception list, it is not highlighted.
Of course not - the mere fact you put something in the exclusion list is of no consequence if the word isn't a spelling error. The macro checks for spelling errors, not for words in your list, per se.

[translator_]

Sure, I understand that. But is it possible to have the words in exclusion list highlighted no matter what?

[macropod]

Yes, but it'd have been nice if you'd said that was a requirement up front. Asking for people to keep re-writing code because you haven't properly specified your requirements won't win you any friends.
Sub AutoSpellCorrect()
Application.ScreenUpdating = False
Dim Rng As Range, oSuggestions As Variant
Dim StrExcl As String, i As Long, lHlt As Long
StrExcl = ",word1,word2,word3,"
lHlt = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdPink
With ActiveDocument.Range
With .Find
.ClearFormatting
.Format = False
.MatchWholeWord = True
.MatchCase = True
.Wrap = wdFindContinue
With .Replacement
.ClearFormatting
.Text = "^&"
.Highlight = True
End With
For i = 1 To UBound(Split(StrExcl, ",")) - 1
.Text = Split(StrExcl, ",")(i)
.Execute Replace:=wdReplaceAll
Next
End With
For Each Rng In .SpellingErrors
With Rng
If InStr(StrExcl, "," & .Text & ",") = 0 Then
If .GetSpellingSuggestions.Count > 0 Then
Set oSuggestions = .GetSpellingSuggestions
.Text = oSuggestions(1)
End If
Else
.HighlightColorIndex = wdBrightGreen
End If
End With
Next
End With
Options.DefaultHighlightColorIndex = lHlt
Application.ScreenUpdating = True
End Sub

[translator_]

Many thanks. You are absolutely correct, my bad. Not intentional though.

Mind you, the latest code highlights like this:

Thief Only comments may made mie mrt appear after End Sub pase pastor paraimikros

So, despite the fact that all highlighted words belong to the exclusion list, may, has different highlight colour and paraimikros, which has no suggestion, is not highlighted at all (it is highlighted when using your initial code though).

[macropod]

OK, in that case, after:
.Text = oSuggestions(1)
insert:
Else
.HighlightColorIndex = wdPink

[translator_]

Many thanks, Paul. It does fix the last word not in dictionary which was not highlighted (paraimikros), but it still applies 2 kinds of highlights for words in exclusion list, i.e.:

Thief Only comments may made mie mrt appear after End Sub pase pastor paraimikros

That means, that 3 exclusion list words (mie,mrt,pase) have Green colour, and one (may) has Pink.

If the exclusion list colour is pink, then may is correctly highlighted. But in that case, (mie,mrt,pase) should also have pink and green should be used only for words for which there is no suggestion in Word's dictionary and, of course, are not in the exclusion list (only paraimikros in this test).

[macropod]

Swap:
.HighlightColorIndex = wdBrightGreen
with:
.HighlightColorIndex = wdPink

[translator_]

Paul, thanks, but swapping the colour is not the point. It is the fact that all exclusion list words should have the same colour (no matter which of the two, but consistently), and, as I noted, one of them (may), has a different one although it is in exclusion list.

[macropod]

Evidently you haven't tried the change ...

[translator_]

Yes, you are right again, many thanks, your help is very much appreciated :)