search for a word and replace each one only if it does not match a particular style

[dangles1266]

I was asked to write a macro for someone to use in word (2010). They want to use the Find and Replace to search for the word “shall” in any style except in the style “KEEP” and replace “shall” with the word “will”. The person wants to stop at each occurrence along the way and see what happens. With this request, I want to use .Execute Replace:=wdReplaceOne, since using ReplaceOne will find, replace, and highlight the change, and let the user see what just happened. If the change is desired, then the user presses the macro button again to jump to the next occurrence and continues through the document in that manner. If they do not agree with the change, then they can press undo.

I searched online for others with the same desire to change and replace with style exceptions (including this site) and started modifying their code to match my desired outcome. I have numerous tests that have not worked. Can someone fix the code? Thanks.
Sub TEST_FND_shall_RPLC_will_EXCEPTKEEPSTYLE()
'
With Selection.Find
.Text = "shall"

.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False

.MatchSoundsLike = False
.MatchAllWordForms = False

If Selection.Find.Found = True And Selection.Find.Style <> ("KEEP") Then Selection.Find.Replacement.Text = "will"
Selection.Find.Execute Replace:=ReplaceOne
End With
End Sub

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "shall"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.Execute
End With
Do While .Find.Found
If .Style <> "KEEP" Then .Text = "will"
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub

[gmaxey]

What about "Shall" and "Will?"


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[Ss]hall"
.MatchWildcards = True
While .Execute
With oRng
If .Style <> "KEEP" Then
If .Characters.First = "S" Then
.Text = "Will"
Else
.Text = "will"
End If
.Collapse wdCollapseEnd
End If
End With
Wend
End With
End Sub

[macropod]

You don't need no wildcard Find or fancy-ants upper-case If test for that:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "shall"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.Execute
End With
Do While .Find.Found
If .Style <> "KEEP" Then .Text = Chr(Asc(.Characters.First) + 4) & "ill"
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub

[gmaxey]

Paul,

"If .Style <> "KEEP" Then .Text = Chr(Asc(.Characters.First) + 4) & "ill"

I thought my mud was clearer ;-)

[macropod]

I thought your mud needed a little more stirring...

[gmaxey]

Touché ;-)