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

Chris Macro

Well-known Member
Joined
Nov 2, 2011
Messages
1,343
Office Version
  1. 365
Platform
  1. Windows
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:


Code:
'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:
Code:
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
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,875
Office Version
  1. 2019
  2. 2016
  3. 2010
Platform
  1. Windows
Hi Chris,

Try this code:
Rich (BB 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
 
Last edited:

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,633
Try something based on:
Code:
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:
Code:
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

Well-known Member
Joined
Nov 2, 2011
Messages
1,343
Office Version
  1. 365
Platform
  1. Windows
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

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,875
Office Version
  1. 2019
  2. 2016
  3. 2010
Platform
  1. Windows
To work with selection only use With Selection.Find and .Wrap = wdFindStop
 

ZVI

MrExcel MVP
Joined
Apr 9, 2008
Messages
3,875
Office Version
  1. 2019
  2. 2016
  3. 2010
Platform
  1. Windows
Chris, I am glad our suggestions were useful :)
 

Chris Macro

Well-known Member
Joined
Nov 2, 2011
Messages
1,343
Office Version
  1. 365
Platform
  1. Windows
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:

Code:
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
 

Chris Macro

Well-known Member
Joined
Nov 2, 2011
Messages
1,343
Office Version
  1. 365
Platform
  1. Windows
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!
 

Forum statistics

Threads
1,170,932
Messages
5,872,776
Members
432,944
Latest member
mj02

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top