Find Specific Words & Apply Individual RGB Font Colors

[saphire99]

Hello to all,

I hope every one is doing great this evening. :hi:

I have come back to ask for some help.

This may be a regex problem, that I have become confused with again, or there may be another way to do this but I am not very sure.

I am going through my documents that have specific words that need to have a font color applied to it.

The words have a code in front.

Sample Example

**2 Daniel - Name
**8 Joe - Surname

**3 Town - Name

**2 ReportID - Details

I need to find the specific words that have a

** in front and then give each word next to it a different RGB Font Color and make it bold.
Delete the original code.




Example

Before

**3 Town - Name

**2 ReportID - Details


After

Town - Name

ReportID - Details


I only need The first word to have the RGB font color applied to it.


I am not very regex fluent. I have got stuck and just don't know how to move forward.:crying::crying:

I have got these all over and - that is a lot of coloring to do - as you may imagine, finding the ** followed by numbers.

I thought I would try the VBA again.




Sub FindText

'Find Text that has a code infront

Dim myText As Word.Range
Set myText = ActiveDocument.Range
With myText.Find

For Each mytext In ActiveDocument

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.myText = "(**)[1][0-9]{1,}"
.Replacement.Text = ""

If InStr(1, myText.Range.Text, "**2") = 1 Then
myText.Range.Font.Color = RGB(40, 202, 67)
myText.Bold = True
Delete the **2

ElseIf InStr(1, myText.Range.Text, "**3") = 1 Then
myText.Range.Font.Color = RGB(91, 155, 213)
myText.Bold = True
Delete the **3

ElseIf InStr(1, myText.Range.Text, "**8") = 1 Then
myText.Range.Font.Color = RGB(235, 11, 213)
myText.Bold = True
Delete the **8

Else

Nothing

End if

End Sub





I just don't know what else to do.

I would be so grateful for the expert opinion on my offering - which is not looking very good at the moment. Saying that I have spent the whole day trying to learn about regex :blush.

I also have a feeling that the instr(function) may not be the best?

So very grateful for the help.

thank you so much in advance for helping me again.:)

Saphire

[gmaxey]

Saphire,

Nothing you have tried or nothing provided is actually regex. It is just a VBA wildcard search. Use something like this:



Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Dim oWord As Word.Range
Randomize
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "\*\*[0-9]{1,} "
.MatchWildcards = True
While .Execute
Set oWord = oRng.Words.Last.Next
oWord.MoveEndUntil " ", wdForward
oWord.Font.Color = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 * Rnd) + 1))
oRng.Delete
oRng.Collapse wdCollapseEnd
Wend
End With
lbl_Exit:
Exit Sub

End Sub

[saphire99]

Hello Greg,

hope you are doing great this Sunday!

Thank you so much for helping me. :biggrin:

This is amazingly incredible - it makes all the words a different color, and it deletes the ** too.

I love it. So this is solved!


However I must implore for your additional help to extend this code , is there any way to set the font colors.



For example all the

**2 to be one RGB color only

**3 to be a different RGB color

This is because later on it will help me to find them by color and edit,delete,update or move these items for inspection.

Am I able to modify below to a fixed RGB for each

oWord.Font.Color = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 * Rnd) + 1))


I assume it is more complicated?

It may need a loop or array of some type - which I am briefly acquainted with - but am a bit fearful of approaching after yesterdays regex failure.

Thank you so much Greg, hope you won't mind helping me to complete this colossal task. When you have a lot of editing to do you always make mistakes.

Vis a vis the regEx - it is not a very easy language to dissect, it never works when I put it in the wildcard find and replace.


thank you for helping me :biggrin:


Saphire

[gmaxey]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Dim oWord As Word.Range
Dim oCol As New Collection
Dim strNum As String
Dim strRGB() As String
'You will need to add a collection item for each code numerical value.
oCol.Add "255|0|255"
oCol.Add "0|255|255"
oCol.Add "255|255|0"
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "\*\*[0-9]{1,} "
.MatchWildcards = True
While .Execute
strNum = Trim(Mid(oRng.Text, 3, Len(oRng.Text) - 2))
Set oWord = oRng.Words.Last.Next
oWord.MoveEndUntil " ", wdForward
strRGB = Split(oCol.Item(CLng(strNum)), "|")
oWord.Font.Color = RGB(strRGB(0), strRGB(1), strRGB(2))
oRng.Delete
oRng.Collapse wdCollapseEnd
Wend
End With
lbl_Exit:
Exit Sub
End Sub

[saphire99]

Hello Greg,

thank you for going the extra mile to help me. :)

Please forgive my ignorance but I need to add some items to it in a collection? Do I create some variables?

I ran the module

strRGB = Split(oCol.Item(CLng(strNum)), "|") This line gives an error.


I found this on collections

http://www.wiseowl.co.uk/blog/s239/collections.htm


Am i in the right direction?

Thank you so much for the generous help :biggrin:

Saphire

[gmaxey]

Saphire,

Your original Sample Example:

**2 Daniel - Name
**8 Joe - Surname
**3 Town - Name
**2 ReportID - Details

Here you have code number 2, 3 and 8. This means your collection will need to have 8 members (the highest code number).
The code I provided only has 3:

oCol.Add "255|0|255"
oCol.Add "0|255|255"
oCol.Add "255|255|0"

Just add 5 more e.g,
oCol.Add "1|1|1"
oCol.Add "20|20|20"
...
oCol.Add "50|50|50"

[saphire99]

Dear Greg,
This is some advanced black magic! I am sure you need a license to practice this kind of skill.:wizard:


I am floored and thrilled! :biggrin:

You are a true master !

Thank you so much.
I have been trying to solve this problem for the past 3 months on and off. I have been searching and adapting macros by inserting my own code and before you know it we have code spaghetti.:dau:


I have these large documents that have all these codes in them - I had to find them and edit, update, delete etc, but how was I supposed to find them all. Then manually highlight etc. I was losing the will to live. :crying: :hide:

I had at least 10 macros - one for each ** - but that was taking ages to run,one after the other , I also forgot to run some macros.

- hence more headache. Needless to say - I had a big problem with my documents.


I am incredibly grateful to benefit from your wisdom and experience, and generosity also the patience expended to help newbies who ask silly questions.

Thank you so much again

You have made my whole year !

This is a phenomenally outstanding module - extremely useful and functional, I will use it everyday, as there is always something I need to find and change the font color of in my documents.

Also others can adapt it to their own code and use it to.

Thank you again and have a great day. :biggrin:

Saphire

XOXOXO

Happy new year 2016 :wavey:


This thread is solved twice

[saphire99]

Please Mark as Solved - Thank you to forum