0
votes

I am working on a macro that highlights punctuation within a selected range.

The first example in the image shows what the highlighter looks like when run on the first line of text. When a normally sized area is selected, it works as intended and highlights the punctuation within the selection.

The second example in the image shows what the highlighter does when no range is selected, but the cursor is left right before the "a" that begins the second line of text. Notice that the range is runaway and selects everything AFTER the cursor.

The third example in the image shows what the highlighter does when the range is ONE SPACE. In this example, I selected just the right parenthesis after the "a" that begins the second line; in other words, the selected range is from the beginning to the end of the parenthesis. Notice that the range is runaway, but in both directions above and below the second line: it has run on the entire document.

Examples
enter image description here

Sub Review_Highlighter()

''Initialize variables
Dim strKey As Variant
Dim d As Object

'Instantiate Dictionary object "d" for punctuation to highlight
Set d = CreateObject("Scripting.Dictionary")

' Clear existing formatting and settings in Find and Replace fields
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Application.ScreenUpdating = False

'Add dictionary values
'd.Add "[Text To Replace]", "[Replacement Text]"
d.Add "(", "("
d.Add ")", ")"
d.Add "[", "["
d.Add "]", "]"
d.Add "{", "{"
d.Add "}", "}"
d.Add ".", "."
d.Add ",", ","
d.Add ";", ";"
d.Add ":", ":"
d.Add "-", "-"
d.Add "+", "+"
d.Add "_", "_"
d.Add "%", "%"
d.Add "#", "#"
d.Add "$", "$"
d.Add ">", ">"
d.Add "<", "<"
d.Add Chr(39), Chr(39)
d.Add Chr(173), Chr(173)
d.Add """", """"
d.Add "?", "?"
d.Add "!", "!"
d.Add "/", "/"
d.Add "\", "\"
d.Add "=", "="
d.Add "*", "*"
d.Add "<d", "d"
d.Add "<cl", "cl"
d.Add Chr(183), Chr(183)
d.Add "  ", "  "
d.Add "   ", "   "

'Get selection in the selection range
With Selection.range.Find
    .Format = True
    .MatchWholeWord = True
    .MatchAllWordForms = False
    .MatchWildcards = False
    .Wrap = wdFindStop
    .Forward = True
  
    'For each index number in each dictionary, replace text with same text highlighted,
    ' red for period, pink for comma, yellow for colon or semicolon,
    ' green for all other punctuation, and red for special words.
    'For each key in d, replace text with key value
    For Each strKey In d.Keys()
        .MatchWildcards = False
        .Text = strKey
        If .Text = "." Then
            Options.DefaultHighlightColorIndex = wdDarkRed
        ElseIf .Text = "," Then
            Options.DefaultHighlightColorIndex = wdPink
        ElseIf .Text = ";" Or .Text = ":" Then
            Options.DefaultHighlightColorIndex = wdYellow
        Else
            Options.DefaultHighlightColorIndex = wdBrightGreen
        End If
        If .Text = "<d" Or .Text = "<cl" Or .Text = "   " Or .Text = "  " Then
            Options.DefaultHighlightColorIndex = wdGray25
            .MatchWildcards = True
        End If
        .Replacement.Text = d(strKey)
        .Replacement.Highlight = True
        .Execute Replace:=wdReplaceAll
        .MatchWildcards = False
    Next
    
End With

'Deallocate memory
Set d = Nothing
Set strKey = Nothing

Application.ScreenUpdating = True

End Sub

I tried starting up a range object with

Dim RngSel As range
Set RngSel = Selection.range

and setting up the selection with

'Get selection in the selection range
With ActiveDocument.range
    .Start = RngSel.Start
    .End = RngSel.End
    With .Find
        .Format = True
        .MatchWholeWord = True
        .MatchAllWordForms = False
        .MatchWildcards = False
        .Wrap = wdFindStop
        .Forward = True

It results in the same situation, except for both the second and third cases, it selects the entire document.

I have heard about the finicky dynamically selected range in Word, and was wondering what I was doing wrong, and if there is any workaround to mitigating this issue.

1
The mitigation you need is to read up on the range.find object and it's methods so that you gain an understanding of its correct use.freeflow
@freeflow Can you recommend something for benlli to read on this?Charles Kenyon
In the VBA IDE place the cursor on the find of a <range>.find statement and press F1. This will bring up the MS help page on the find object. If the OP is intelligent and determined enough, this will be a sufficient start.freeflow
Ranges are more dynamic than selections and are not designed or expected to stay in lockstep with Selections. Of course, a Selection is a Range in that it has a designated start and ending address within the document but that is not to say that Ranges are solely created by a Selection. Programmatically you can assign a Range to anywhere in the document, regardless of where the current Selection Range is located. Ranges that are not associated with a Selection have to be initialized. You cannot just declare a Range variable and then give it a starting and ending address ... to be continued.Rich Michaels
After declaring a Range you must initialize it with a document content assignment, for example ... Set rng = ActiveDocument.Content or ActiveDocument.Tables(1).Range. Once that is done you can reassign the Range's starting and ending points. The bottom line is there is not a Bug in how Ranges are operating. Unfortunately for you is you have a misunderstanding in how you are attempting to use them.Rich Michaels

1 Answers

0
votes

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, i As Long
StrFnd = "[\!-/\:-\?\[-`\{-\}‘-”·­]|[\:\;]|.|,|[ ]{2,}|<d|<cl"
With Selection
  If .Type = wdSelectionIP Then Exit Sub
  If InStr(Trim(.Text), " ") = 0 Then Exit Sub
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    For i = 0 To UBound(Split(StrFnd, "|"))
      Select Case i
        Case 0: Options.DefaultHighlightColorIndex = wdBrightGreen
        Case 1: Options.DefaultHighlightColorIndex = wdYellow
        Case 2: Options.DefaultHighlightColorIndex = wdDarkRed
        Case 3: Options.DefaultHighlightColorIndex = wdPink
        Case 4 - 6: Options.DefaultHighlightColorIndex = wdGray25
      End Select
      .Text = Split(StrFnd, "|")(i)
      .Execute Replace:=wdReplaceAll
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub