Code to highlight all text between quotation marks (Word VBA)

Topic

New Reply

Someone on the Microsoft VBA general board asked how to highlight all the text between quotation marks in a document. I worked on it for a while and thought I would share the code which uses (1) a CountWord function from the MVP site, (2) the browser object, the wdExtend action, and (4) some simple message boxes.

Question: How would I use the Range Object instead of the Selection Object? Is there any advantage to doing so?

Anyway, it works and I’m proud of it.

Sub HighlightBetweenQuotes()
'
' HighlightBetweenQuotes Macro
' Macro written 11/19/01 by Charles Kyle Kenyon
'
'   Get number of quotation marks in document using CountWord function from MVP site
'   That function is copyrighted and not repeated here, however, original
'       can be downloaded and used from the MVP FAQ site
'   As of the date this was written, the URL is:
'   "]http://www.mvps.org/word/FAQs/MacrosVBA/Ge...placements.htm>[/url]
'   CountWord is the second function on that page.
'
    Dim sResponse As String
    Dim iNumber As Integer
    Dim iCheck As Integer
    sResponse = """"
    iNumber = CountWord(sResponse)
'
'   Check for even number of quotation marks (pairing)
'
    iCheck = iNumber / 2
    If iCheck * 2  iNumber Then ' not an even number
        MsgBox Prompt:="Sorry, there are " & iNumber _
            & " quotation marks in this document." _
            & vbCrLf & "This will only work with paired " _
            & "quotation marks.", _
            Title:="Odd number of quotation marks!", _
            Buttons:=vbExclamation
        Exit Sub
    End If
'
'
'   Go to beginning of document
    Selection.HomeKey Unit:=wdStory
'
'   Set Up Find " in Browse Object
'
'
    With Selection.Find
        .ClearFormatting
        .Text = """"
        .Replacement.Text = """"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
    End With
    Selection.Collapse (wdCollapseStart)
    Application.Browser.Target = wdBrowseFind
    '
    For iNumber = 1 To iCheck 'number of pairs
    '
    '   Select First quotation mark and move past it
    '
        Application.Browser.Next
        Selection.Collapse (wdCollapseEnd)
    '
    '   Extend Selection to next quotation mark and then bring back inside
    '
        Selection.Extend
        Application.Browser.Next
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    '
    '   Highlight selection
    '
        Selection.Range.HighlightColorIndex = wdYellow
        Application.Browser.Next
        Application.Browser.Next
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Next iNumber
    '
    '   Return to beginning of document
    '
    Selection.HomeKey Unit:=wdStory
    '
    '   Let User know what happened.
    '
    MsgBox Prompt:="All text between quotation marks highlighted in " _
        & iCheck & " pairs of quotation marks. Finished." _
        & vbCrLf & vbCrLf & "Please look it over now. Use Undo (Ctrl-Z) " _
        & "to fix if necessary.", _
        Title:="Finished with Highlighting", _
        Buttons:=vbInformation
End Sub

Here’s a “hot” link to Get the Number of Replacements Done (including CountWord function) on the MVP site – since the preformatted version doesn’t go live on this system. It’s not supposed to, I know.

Wanted to share and brag a bit. Any thoughts or refinements appreciated.

Reply | Quote

Replies

Although I was impressed by my work, turns out that it was overkill. As often happens, a better use of built-in features is much easier.

The following was a posting by Klaus Linke responding to the same question. It suggests use of the * wild card.:
————————-Start—-
Assuming your quotes are smart quotes, the following *wildcard*
Find/Replace should work, too:
Find what: “*”
Replace with: ^& ((choose “More > Format > Highlighted”))

The “Find what”-text should contain smart (= typographic = curly)
quotes; you can copy/paste them from the text into the dialog, or type
them with Alt-0147 and Alt-0148.

If your text doesn’t contain smart quotes, you can change the quotes
to smart quotes with “Format > AutoFormat”; uncheck everything but
“Smart quotes” in “Options…”.
———————————–End—

If it matters that the quotation marks are also being highlighted (rather than just the text between them) then it should be a simple matter to run a second replace to strip the highlight formatting.

Oh well…

Reply | Quote

Hi Charles,

Your solution was very ingenious. I have never used Application.Browser: That is definitely something I’ll keep in mind

With the wildcard search (as with most wildcard searches), you should jump to the beginning of the document first, so the search doesn’t start in the middle of a quote.
The wildcard search works with straight quotes, too (“*” matches everything from the first quote to (and including) the second quote, then starts searching again after the second quote. But as you said in your solution, it’s pretty risky if there are any unmatched quotes: The replacement will get “out of step”.

(Sorry Charles, had asked about WordCount, and deleted it a few minutes later when I read the FAQ article at http://www.mvps.org/word)

Klaus

Reply | Quote

To continue this resource, the following related macro appeared in the Nov 19 issue of Word Tips Gold. It strips out the quotation marks and changes the quoted text to Italics.

          Sub QuotesToItalic()
          Dim Redo As Integer, Ptr As Integer, Ptr1 As Integer
          Dim P As String, P1 As String
          If Selection.ExtendMode Then Exit Sub
          Redo = -1
          While Redo
              Selection.StartOf Unit:=wdParagraph, Extend:=wdMove
              Selection.MoveEnd Unit:=wdParagraph
              P = Selection.Text
              Ptr = InStr(P, Chr(34))
              If Ptr = 0 Then Ptr = InStr(P, Chr$(147))
              If Ptr > 0 Then
                  Selection.MoveLeft Unit:=wdCharacter, Extend:=wdMove
                  Selection.MoveRight Unit:=wdCharacter, Count:=Ptr
                  Selection.MoveEnd Unit:=wdParagraph
                  P1 = Selection.Text
                  Ptr1 = InStr(P1, Chr(34))
                  If Ptr1 = 0 Then
                      Ptr1 = InStr(P1, Chr$(148))
                      EndChar = Chr$(148)
                  Else
                      EndChar = Chr$(34)
                  End If
                  If Ptr1 > 0 Then
                      Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdMove
                      Selection.Delete Unit:=wdCharacter
                      Selection.MoveRight Unit:=wdCharacter, Count:=Ptr1 - 1, _
                         Extend:=wdExtend
                      Selection.Font.Italic = True
                      Selection.MoveRight Unit:=wdCharacter, Extend:=wdMove
                      Selection.Delete Unit:=wdCharacter
                  Else
                      Selection.MoveRight Unit:=wdCharacter, Extend:=wdMove
                      Redo = 0
                  End If
              Else
                  Selection.MoveRight Unit:=wdCharacter, Extend:=wdMove
                  Redo = 0
              End If
          Wend
          End Sub

There are always different ways to do the same thing.

Reply | Quote

The last macro works for nearly all combinations of straight and curly quotes, it only fails for curly opening quotes and straight closing quotes.
If lines 10 and 11 are replaced with

              Ptr = InStr(P, Chr(147))              
              If Ptr = 0 Then Ptr = InStr(P, Chr$(34))

it works for all combinations.

Also, the macro runs on one paragraph and then stops.
To make it run on all paragraphs to the end of the document, you can remove the two lines “Redo=0” and put the following query at the end:

    If Selection.End + 1 = ActiveDocument.Content.End Then
      Redo = 0
    End If
  Wend
End Sub

Klaus

Reply | Quote