.matchwholeword = true not working

dsrt16 · #1 11-16-2022, 02:18 PM

So I have this code from Allen Wyatt that used to be working just fine, but now it puts even parts of words in red, even though I have set .matchwholeword to true.

So if I have the word "or" on my confusables list, it will put the "or" in the word "color" in red, but I only want the actual word "or" to be in red.

Code:

Sub CompareWordList()
    Dim sCheckDoc As String
    Dim docRef As Document
    Dim docCurrent As Document
    Dim wrdRef As Object

    sCheckDoc = "the path to my confusables.doc"
    Set docCurrent = Selection.Document
    Set docRef = Documents.Open(sCheckDoc)
    docCurrent.Activate

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Color = wdColorRed
        .Replacement.Text = "^&"
        .Forward = True
        .Format = True
        .MatchWholeWord = True
        .MatchCase = False
        .MatchWildcards = False
    End With

    For Each wrdRef In docRef.Words
        If Asc(Left(wrdRef, 1)) > 32 Then
            With Selection.Find
                .Wrap = wdFindContinue
                .Text = wrdRef
                .Execute Replace:=wdReplaceAll
            End With
        End If
    Next wrdRef

    docRef.Close
    docCurrent.Activate
End Sub

It used to work, then it didn't. So I tried moving the .matchwholeword = true to earlier in the with selection find section so it came before the replacement font, but then that caused a different error, highlighting the "for each wrdref line."

Any ideas? I am an editor, and I use this to change words to red that are often confused with other words or often need punctuation with them to help me catch additional errors, but it is distracting to have it put parts of words in red.

macropod · #2 11-18-2022, 04:33 PM

Apart from anything else, the code you're using is extremely inefficient. Try:

Code:

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, i As Long
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc", ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
FRList = FRDoc.Range.Text: FRDoc.Close False: Set FRDoc = Nothing
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Replacement.Font.Color = wdColorRed
  .Replacement.Text = "^&"
  .Forward = True
  .Format = True
  .MatchWholeWord = True
  'Process each entry from the source list.
  For i = 0 To UBound(Split(FRList, vbCr)) - 1
    .Text = Split(FRList, vbCr)(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

The above code assumes the strings to be found are separated by paragraph breaks. This allows you to process multi-word strings. If you're using spaces instead, use:

Code:

Sub BulkFindReplace()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, i As Long
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\FindReplaceList.doc", ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
FRList = FRDoc.Range.Text: FRDoc.Close False: Set FRDoc = Nothing
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Replacement.Font.Color = wdColorRed
  .Replacement.Text = "^&"
  .Forward = True
  .Format = True
  .MatchWholeWord = True
  'Process each entry from the source list.
  For i = 0 To UBound(Split(FRList, " "))
    .Text = Split(FRList, " ")(i)
    .Execute Replace:=wdReplaceAll
  Next
End With
Application.ScreenUpdating = True
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
True/False Error	DonBerg68	Excel	2	08-30-2019 08:51 PM
if true AND nested or?	jriker1	Mail Merge	5	10-14-2017 01:11 PM
Converting a 1 or 0 into TRUE or FALSE?	ayupchap	Mail Merge	1	04-25-2017 02:45 PM
True 4:3 background dimensions	a_gunslinger	PowerPoint	1	11-28-2016 08:22 PM
Macro not staying true	oluc	Word VBA	4	11-21-2010 08:10 AM