Word Select Highlight

Question

Hello From Steve

Is the possible to select the below and highlight Green

$10

$150

$167,000

$1,230,000

I thank you

Answer 1

Hi Steve

I did test the code in my Word, and it ran successfully both times.

The steps I followed were: opening the VBA editor, inserting a new module, pasting the code into it, closing the VBA editor, and running the macro by pressing Alt+F8.

Before

After

Did you follow the same steps as I did? Additionally, is your data similar to the test data I used?

Regards,

Jonathan Z

Answer 2

Hello Jonathan

This time It is doing nothing.

Jonathan question please

Have you tested, if that is the case and the script you have just giving me Functions as it should.

Then I know that the issue lies with me.

All the best

Steve

Answer 3

Hi Steve

Check this new one：

Sub HighlightExactDollarAmounts() 

    Dim regex As Object 

    Dim matches As Object 

    Dim match As Variant 

    Dim rng As Range 

    Dim nextChar As String 

    Dim nextTwoChars As String 

    Set regex = CreateObject("VBScript.RegExp") 

    regex.Global = True 

    regex.Pattern = "\$(10|150|167,000|1,230,000)" 

    For Each rng In ActiveDocument.StoryRanges 

        Do 

            Set matches = regex.Execute(rng.Text) 

            For Each match In matches 

                Set rngFound = rng.Duplicate 

                rngFound.Start = rng.Start + match.FirstIndex 

                rngFound.End = rngFound.Start + Len(match.Value) 

                If rngFound.End < rng.End Then 

                    nextChar = Mid(rng.Text, rngFound.End - rng.Start + 1, 1) 

                    nextTwoChars = Mid(rng.Text, rngFound.End - rng.Start + 1, 2) 

                    If Not (IsNumeric(nextChar) Or (Len(nextTwoChars) = 2 And Mid(nextTwoChars, 1, 1) = "," And IsNumeric(Mid(nextTwoChars, 2, 1)))) Then 

                        rngFound.HighlightColorIndex = wdBrightGreen 

                    End If 

                Else 

                    rngFound.HighlightColorIndex = wdBrightGreen 

                End If 

            Next 

            Set rng = rng.NextStoryRange 

        Loop Until rng Is Nothing 

    Next 

End Sub 

Regards,

Jonathan Z

Answer 4

Hello Jonathan

Firstly thank you,

I am getting a Compile error. it is selecting Right and "Highliting it"

If Not IsNumeric(nextChar) And Not (Left(nextTwoChars, 1) = "," And IsNumeric(Right(nextTwoChars, 1))) Then

Compile Error:

Wrong number of arguments or invalid property assignment.

All the Best

Steve

Answer 5

Hi Steve,

The following code can meet your needs. The effect is as shown in the image:

Please note the parts highlighted in red in the image (not the effect of the code). These amounts also contain the aforementioned characters, but the $10 or $150 in them will not be highlighted because they are only part of the field. If you also need to highlight the characters in these amounts, you can let me know in your reply.

Here is the complete code:

Sub HighlightExactDollarAmounts() 

    Dim regex As Object 

    Dim matches As Object 

    Dim match As Variant 

    Dim rng As Range 

    Dim nextChar As String 

    Dim nextTwoChars As String 

    Set regex = CreateObject("VBScript.RegExp") 

    regex.Global = True 

    regex.Pattern = "\$(10|150|167,000|1,230,000)" 

    For Each rng In ActiveDocument.StoryRanges 

        Do 

            Set matches = regex.Execute(rng.Text) 

            For Each match In matches 

                If match.FirstIndex + Len(match.Value) < Len(rng.Text) Then 

                    nextChar = Mid(rng.Text, match.FirstIndex + Len(match.Value) + 1, 1) 

                    nextTwoChars = Mid(rng.Text, match.FirstIndex + Len(match.Value) + 1, 2) 

                    If Not IsNumeric(nextChar) And Not (Left(nextTwoChars, 1) = "," And IsNumeric(Right(nextTwoChars, 1))) Then 

                        Set rngFound = rng.Duplicate 

                        rngFound.Start = rng.Start + match.FirstIndex 

                        rngFound.End = rngFound.Start + Len(match.Value) 

                        rngFound.HighlightColorIndex = wdBrightGreen 

                    End If 

                Else 

                    Set rngFound = rng.Duplicate 

                    rngFound.Start = rng.Start + match.FirstIndex 

                    rngFound.End = rngFound.Start + Len(match.Value) 

                    rngFound.HighlightColorIndex = wdBrightGreen 

                End If 

            Next 

            Set rng = rng.NextStoryRange 

        Loop Until rng Is Nothing 

    Next 

End Sub 

I look forward to you sharing the results with me.

Best Regards,

Jonathan Z - MSFT | Microsoft Community Support Specialist