VBA MS Word - Change Color of text after an Apostrophe (my Loop is stuck!)

[Chris Macro]

Hi, I am trying to mimic how the VBA Editor changes commented text to green (with an apostrophe as the indicator) in a Word Document's text. I am approaching this by using the Find function to find all the apostrophe's in my selection and then select to the end of the line and change that selection to green. Unfortunately my code gets stuck in an infinite loop on the first line of my sample text. I believe this is because I am changing the selection range when I use the extend command. Anyone know how I can fix this code or maybe there is another way to approach my problem? Thanks for your time!

I have the following testing Text:

'Hello World
'It's my car!
 
Dim myOrgColor As Double          'original color of color index 32
Dim myNewColor As Double      'color that was picked in the dialogue
Dim myRGB_R As Integer           ' RGB values of the color that will be
Dim myRGB_G As Integer            'displayed in the dialogue as
Dim myRGB_B As Integer            'It's my car!

Here is my code so far:

Sub Sample()

    '~~> Loop through the array to get the search text
    
        With Selection.Find
            .ClearFormatting
            .Text = "'"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Execute


            '~~> Change the attributes
            Do Until .Found = False
                Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                Selection.Font.Color = RGB(0, 128, 0)
                Selection.Find.Execute
            Loop
        End With


End Sub

 

[ZVI]

Hi Chris,

Try this code:

Sub ColorComments()
  With ActiveDocument.Content.Find
    .ClearFormatting
    .Text = "'*[^13]"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Replacement.Font.Color = wdColorGreen
    .Format = True
    .Forward = True
    .Wrap = wdFindContinue
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End Sub

Regards

 

[Macropod]

Try something based on:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
Set Rng = Selection.Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "'"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    .Select
    With Selection
      .EndKey Unit:=wdLine, Extend:=wdExtend
      MsgBox .Text
      .Font.Color = RGB(0, 128, 0)
    End With
    .End = Selection.End
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Rng.Select
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

The key to getting this to work is to collapse the range to its end and NOT using '.Wrap = wdFindContinue'.

However, since it seems your text lines are terminated by paragraph breaks or line breaks, you could do the lot without code, using a wildcard Find/Replace, where:
Find = '[!^13^l]@[^13^l]
Replace = ^&
and the replacement text colour is specified for the required green hue. As a macro, this becomes:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Text = "'[!^13^l]@[^13^l]"
  With .Replacement
    .Text = "^&"
    .ClearFormatting
    .Font.Color = RGB(0, 128, 0)
  End With
  .Format = True
  .Forward = True
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

and will execute much faster than anything using loops and selections.

 

[Chris Macro]

Thank you both as both your solutions are working great! Is there any way your solutions (Paul I was looking at your second procedure that you submitted) could be based off of just a user's selected text? I tried using "Selection.Find" but both subroutines highlighted the entire document still.

 

[ZVI]

To work with selection only use With Selection.Find and .Wrap = wdFindStop

 

[Chris Macro]

To work with selection only use With Selection.Find and .Wrap = wdFindStop

Perfect! Thank you so much Vladimir!

 

[ZVI]

Chris, I am glad our suggestions were useful

 

[Chris Macro]

Thanks you guys again for your help. I did run into an issue that I'm not sure how to address. Is there a way to prevent the find function from highlighting the text green if the occurrence of " ' " is written? I ran the macro on the text of the macro itself and it highlighted the phrase: " '*[^13] ". Since this piece of the code is a text string and not considered a comment I would not like this to be highlighted in green. I believe this should be the only instance of when an apostrophe would not trigger the rest of the text to be highlighted.

I'm guessing one possible solution would be to test if a quote occurred before and after the apostrophe in the same line, but I am not sure if that is the direction I should be looking in to or if there is functionality within the Find function that could handle this. Thank you for your expertise!

Code and Text I used in my testing:

Sub Color_VBA_Comments()

'Purpose: Looks for a Quote and changes the rest of that line's font color to Green

  With Selection.Find
    .ClearFormatting
    .Text = "'*[^13]"
    .Replacement.ClearFormatting
    .Replacement.Text = ""
    .Replacement.Font.Color = wdColorGreen
    .Format = True
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End Sub

 

[Macropod]

Try:
.Text = "'[!^13""""]@[^13]"

 

[Chris Macro]

Thanks Paul, that fixed the problem. Would you mind explaining what that criteria looks for? Or maybe if you know a good resource that could teach me how to understand "'[!^13""""]@[^13]"? It looks like you can do some pretty neat stuff if you know how to write it!