CODEWITHSUNDEEP
vbareplacefindwildcarddefined
Yvonne
Yvonne

Reputation: 3

Match string within quotation marks to string out of quotation marks in Word

I have a document that has an index of defined terms in it. Each defined term can be found within quotation marks. Wherever the term is actually used in the document, it is not within quotation marks. Where each term is used in the document, I would like to change its formatting (make the text light grey). In this way, I can easily see what words remain in my document that have yet to be defined (if they have been defined, they will be pale and I will not notice them...dark text stands out) For example:

"Cat" means feline. "Hat" means head gear.

The Cat wears a Hat.

Would turn to this (I used italics instead of grey font as I could not figure out how to change font color here) once macro is run:

"Cat" means feline. "Hat" means head gear.

The Cat wears a Hat.

I know how to use Wildcards in Word to search for all words within quotation marks, but then how to instantly find and replace all such words with a different font eludes me. I have been using Find & Replace for each defined term, and it takes hours to grey-out where all terms are used...

Upvotes: 0

Views: 450

Answers (1)

Tim Williams
Tim Williams

Reputation: 166306

Well, now I know a lot more about Find() in Word than I used to...

This works for me in light testing, but will only the handle simple use case of single-word terms, where no term is a substring of another term.

Sub Tester()

    Dim col As New Collection
    Dim wd, l
    Dim rng As Range, doc As Document

    Set doc = ThisDocument
    Set rng = doc.Content

    'collect all quoted terms
    With rng.Find
        .MatchWildcards = True
        .MatchCase = False
        .Forward = True
        'matching straight or curly quotes...
        Do While .Execute(FindText:="[""" & Chr(147) & "][a-zA-Z]{1,}[""" & Chr(148) & "]")
            wd = Mid(rng.Text, 2, Len(rng.Text) - 2)
            'skip error if already added
            On Error Resume Next
            col.Add wd, wd
            If Err.Number = 0 Then Debug.Print "Quoted:", wd
            On Error GoTo 0
        Loop
    End With

    'search for each quoted term
    For Each wd In col
        Debug.Print "Searching:", wd

        Set rng = doc.Content
        With rng.Find

            .MatchCase = False
            .MatchWildcards = True
            .MatchWholeWord = True
            .Forward = True

            'the only issue here is that the Find is case-sensitive...
            'which is why we need to check for both the init-cap and lower-case versions
            l = Left(wd, 1)
            wd = "[" & LCase(l) & UCase(l) & "]" & Right(wd, Len(wd) - 1)
            Do While .Execute(FindText:="[!""" & Chr(147) & "]" & wd & "[!""" & Chr(147) & "]")

                Debug.Print "  Found:", wd
                rng.Font.ColorIndex = wdGray25

            Loop
        End With
    Next

End Sub

Upvotes: 2

Related Questions