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.
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.