One of our students (hi Leah 🙂 ) sent me a question last week asking how she could change the color of words (sub-strings) in text. She was trying to visually indicate where words were on the sheet.
She supplied some code that she got somewhere on the net. I'm not sure where from so if you recognise it as your own, please let me know so I can attribute it to you.
It is a nice piece of code that uses regular expressions to locate a word in text, and then changes the color of that word. I made a few modifications/enhancements to expand its functionality.
What This VBA Does
Using this code will allow you to :
- Find multiple words (the search is not case sensitive)
- Change the color of each of those words (to different colors if you like)
- Check a single cell, or any size range
- Check for any text string
Because the code looks for a text string, you don't have to just look for real words, you can search for any text string, e.g. "INVOICE 1234".
I've written the code so that it uses the .CurrentRegion property to search all cells in the current region
What's the CurrentRegion?
Well, Microsoft's definition is 'The current region is a range bounded by any combination of blank rows and blank columns'
Let's look at a couple of examples. We have data in cells as per this image
If I click into any cell in the range A1:C3 the CurrentRegion is A1:C3 because it is bounded by a blank row (4) which intersects a blank column (D)
If I click into any cell containing xxx the CurrentRegion is A1:E6, because the first blank row and blank column that bound cells containing xxx are Row 7 and Column F.
In fact if you click in the empty cells E5 or E6, the CurrentRegion is still A1:E6 because the first empty row and column bounding E5 or E6 are Row 7 and Column F. Likewise if you click into an empty cell on Row 4 or Column D, the CurrentRegion is A1:E6 for the same reason.
A Little Bonus
On Sheet 2 of the workbook you can download for this post (see below), I've set up a little macro to illustrate how CurrentRegion works. Just click any cell and then click the 'Show CurrentRegion' button.
Right, Back to Changing Word Colors
So you have your worksheet full of text, and you want to color various words in a rainbow that hopefully won't hurt your eyes.
The first thing you need to do is tell the VBA code what the list of words you are looking for are. Then next thing is tell it what colors to use for those words
At the top of the code you'll see these two lines :
MyWords = VBA.Array("Sky", "Grass", "Ruby", "Panther")
MyColors = VBA.Array(vbBlue, vbGreen, vbRed, vbMagenta)
Put whatever words you like in the MyWords array. Make sure you enclose them in double quotes, and separate each word with a comma.
Then in the MyColors array, list the colors you want to use for each word in the MyWords array. The first color will apply to the first word, the second color to the second word etc. So the word Sky will be vbBlue, Grass will be vbGreen, and so on.
You can have one word or a hundred, it's up to you. Just make sure you have exactly the same number of colors as you do words.
Color Constants
The MyColors array is using the Excel color constants, but it is possible to specify any color you like using a color's HEX value.
A lollipop to the first person who tells me how to do this.
MATCH Function
To find the word we want in our list the code uses Excel's MATCH function. Check that article if you are not familiar with how it works.
Conditional Formatting
Using conditional formatting you can't change the color of only part of the text string you are searching for, but you can use conditional formatting or conditional formatting with formulas to highlight cells containing a particular string, or to change the color of all the text in the cell.
The Code
Enter your email address below to download the sample workbook.
Dear Philip & Leah, Thank you so much for this code of coloring text — it is smart, efficient, elegant, and I would never have been able to do this. I also incorporated your suggestion for making the text that is colored bold and it worked great and I am loving it!. I do have about 325 elements in my arrays. I can manually put these elements in the VBA code and it works, but I would prefer to have a separate worksheet with 3 columns that have MyWords, MyColors, and MakeBold elements and refer to these columns in the subroutine. I have tried many things but my last try was inserting as follows:
Dim BoldRange As Range
Set BoldRange = Worksheets(“Products”).Range(“C2:C11”)
MakeBold = BoldRange
When I run the subroutine, I get an error on
MyCell.Characters(MyObj.firstindex + 1, MyObj.Length).Font.Bold = MakeBold(MatchPosition – 1)
that states Run-time error ‘9’: Subscript out of range.
Note I was doing this on only the MakeBold to see if it worked before using something similar on MyWords and MYcolor.
I feel like I am missing something really simple, but if you could guide me in the right direction, I would appreciate it.
I will continue working on it. Again, Thank you so much!!
Hi Cindy,
Subscript out of range probably indicates that your code is trying to refer to an element (e.g. in an array) that doesn’t exist.
Please post your question on our forum and attach your file so we can take a look at it.
Regards
Phil
Hi this is sresta from India , i need help in highlights multiple keywords in Excel file with multiple colors. I tried ur VBA code . But i can use only few colours to highlight keywords… I need to add more colors to keywords by using VBA… I tried a lot but I don’t get solution from anywhere. If possible could you please help me with VBA code .
Hi,
Happy to have a look at your data but I need the file and a precise description of what you want.
Please start a topic on our forum and attach your file.
Regards
Phil
Hi Philip may i know how attach my Excel file ?
After registering as a forum member, you can attach files (within certain limits)
https://www.myonlinetraininghub.com/excel-forum/forum-rules-and-guides/read-this-first
If your file exceeds those limits, upload it to a file sharing service like OneDrive and link to it.
regards
Phil
Hey, Thanks for this wonderful code.
I have a customer feedback data(their comments) in a column and i want to color the keyword that are in my different sheet (3 columns with different keywords about the service:- Good, bad and neutral keywords) (40-50 rows), like Good keywords in Green, Bad in Red and neutral in magenta.
Can you help me with the code, that can find the those keywords and change their font color as per above.?
This is the snapshot of output result.
https://www.dropbox.com/s/71mq9796erid833/IMG_20200525_063440.jpg?dl=0
Thanks in advance!!
Hi Maggie,
I’d be happy to help but it’s easier to do with your workbook.
Please start a topic on our forum and attach your workbook to that.
Regards
Phil
Your code works like a charm! Is it possible to also make the specific words bold in addition to changing the color?
Hi Janice,
Yes you can. At the top of the code you need to declare a new variable called MakeBold, so modify the existing statement to this
Now, assign True or false values that correspond to the word(s) you want to make bold:
Our list of words is (“Sky”, “Grass”, “Ruby”, “Panther”) so the True/False values above mean we want Sky and Ruby to be bold.
Lastly, add a line to the existing If statement below to make the word(s) bold:
If Not IsError(MatchPosition) Then MyCell.Characters(MyObj.firstindex + 1, MyObj.Length).Font.Color = MyColors(MatchPosition - 1) MyCell.Characters(MyObj.firstindex + 1, MyObj.Length).Font.Bold = MakeBold(MatchPosition - 1) End IfRegards
Phil
Beautiful! Thank you so very much!
You’re welcome
Some piece of code this is!!!
I was looking for this for a very long time. Well done to all involved.
Thanks Djim, glad it was useful to you.
Phil
I am still intrigued by the ability to highlight specific words/phases in a cell. Here is another twist that I am struggling with – is it possible to highlight all “occurrences” of a word/phrase in a cell. I am working with a worksheet drawn from an external program that contains large amounts of text in cells in a column (statements made by people about certain events). I currently search for a particular word/phrase using a text filter. Now I wish to highlight “all” occurrences of that word/phrase in each one of the filtered cells rather than only the first occurrence in each cell. For example, all occurrences of “walk” in a cell containing the phrase “While walking on the sidewalk near the boardwalk, I met Bob walking the other way.” “walk shows up 4 times (“walk”ing, side”walk”, board”walk”, “walk:ing) and I would like each instance to be highlighted.
Thanks in advance to any suggestions you might offer.
The key is the Instr function.
On a normal use, the first parameter of Instr function is 1 (this indicates the position of the character to start with)
If we want to check AFTER the first match, (Instr returns only the position of first match), then we have to tell instr to start comparing AFTER the position of the first match. The loop will run until Instr returns 0, this indicates that there are no more matches. The trick is done by using the StartPos parameter, which increases with every occurence found: StartPos = StartPos + TestStr, and passing this parameter to instr function for the next loop: TestStr = InStr(StartPos, MyCell.Text, KeyWords(i, 1), vbTextCompare)
The link to the workbook provided in previous message can be used to download this new version.
Here is the code:
Sub ColorWords()' Written by Philip Treacy, Sep 2014
' My Online Training Hub https://www.myonlinetraininghub.com/change-the-color-of-words-in-text
Dim KeyWords As Variant
Dim MyCell As Range, TargetRange As Range
Dim i As Integer, j As Integer, StartPos As Integer
Dim TestStr As Long
KeyWords = Range("Keywords[[Keywords]:[Color Index]]") 'Add to list as required
Set TargetRange = ActiveCell.CurrentRegion
TargetRange.Font.ColorIndex = xlAutomatic
For Each MyCell In TargetRange.Cells
For i = 1 To UBound(KeyWords, 1)
StartPos = 1
TestStr = 1
Do Until TestStr = 0
TestStr = InStr(StartPos, MyCell.Text, KeyWords(i, 1), vbTextCompare)
If TestStr Then MyCell.Characters(TestStr, Len(KeyWords(i, 1))).Font.ColorIndex = KeyWords(i, 2)
StartPos = StartPos + TestStr
Loop
Next i
Next MyCell
End Sub
Catalin
Awesome! I just tested your code out and it does exactly what I was wanting. I have adapted it to an application I have so that my users can search for a word/phrase and have their terms highlighted throughout the results and across four different worksheets!.
How come you guys are so smart?
Thanks for helping me look at least a little smart. This has been a good day!
Glad to hear that it works as you wanted 🙂
You’re wellcome
Catalin
I modified your code to solve it without RegExp.
What is advantage of using RegExp in this case or it’s just matter of style?
Sub ColorWords2() ' Written by Leonid Dim MyWords, MyColors Dim MyCell As Range, TargetRange As Range Dim word, pos, i MyWords = VBA.Array("Sky", "Grass", "Ruby", "Panther") 'Add to list as required MyColors = VBA.Array(vbBlue, vbGreen, vbRed, vbMagenta) 'Add corresponding color to match MyWords list Set TargetRange = ActiveCell.CurrentRegion TargetRange.Font.ColorIndex = xlAutomatic For Each MyCell In TargetRange.Cells i = 0 MyCell = " " & MyCell & " " For Each word In MyWords pos = InStr(1, MyCell, " " & word & " ") If pos > 0 Then MyCell.Characters(pos, Len(word)).Font.Color = MyColors(i) End If i = i + 1 Next word Next MyCell End SubHi Leonid,
I guess it’s horses for courses. Your way works just as well as using a regex expression.
I did make a few modifications to your code though. I removed this line which I found was adding spaces to either end of the text in the cell
and by specifying vbTextCompare for InStr it made the search case-insensitive.
Also, as I have commas separating my words, I found that searching for ” ” & word & ” “ wasn’t finding a match. So I’ve assumed that there will be some kind of separator between words, whether its a space, a comma or whatever, and I am just searching using this
InStr(1, MyCell, word, vbTextCompare)
Of course doing it this way means that if I search for sky I’ll match Sky and Husky.
Thanks for taking the time to contribute your solution, much appreciated.
Cheers
Phil
Sub ColorWords2() ' Written by Leonid Dim MyWords, MyColors Dim MyCell As Range, TargetRange As Range Dim word, pos, i MyWords = VBA.Array("Sky", "Grass", "Ruby", "Panther") 'Add to list as required MyColors = VBA.Array(vbBlue, vbGreen, vbRed, vbMagenta) 'Add corresponding color to match MyWords list Set TargetRange = ActiveCell.CurrentRegion TargetRange.Font.ColorIndex = xlAutomatic For Each MyCell In TargetRange.Cells i = 0 For Each word In MyWords pos = InStr(1, MyCell, word, vbTextCompare) 'Added vbTextCompare If pos > 0 Then MyCell.Characters(pos, Len(word)).Font.Color = MyColors(i) End If i = i + 1 Next word Next MyCell End SubYou said…
I did make a few modifications to your code though. I removed this line which I found was adding spaces to either end of the text in the cell
MyCell = ” ” & MyCell & ” ”
You do not want to do that. Notice the added spaces in this line of code…
pos = InStr(1, MyCell, ” ” & word & ” “)
The spaces that were added to MyCell allowed InStr to be able to find the “word” at the beginning or at the end of the text as well as internally to the text. Now it was also mentioned that the code the above is from only works if spaces are delimiting the words. I thought you and your readers might be interested in this function which will find a word as a stand-alone word only and will not be tripped up by the word being searched for if it was part of another word. Hence, the following function will correctly find “other” in the text even if words like “brother” or “mother” appear before it. One note, though… the function assume normal English letters; that is, accented letters are treated like non-letters. Okay, with that said, here is the function (note the Start position argument is third in the list, not first, but it is optional.
Function InStrExact(ByVal SearchText As String, _
ByVal FindMe As String, _
Optional ByVal Start As Long = 1, _
Optional ByVal MatchCase As String = False) As Long
Dim X As Long, Pattern As String
Dim Str1 As String, Str2 As String
If MatchCase Then
Str1 = SearchText
Str2 = FindMe
Pattern = “[!A-Za-z0-9]”
Else
Str1 = UCase(SearchText)
Str2 = UCase(FindMe)
Pattern = “[!A-Z0-9]”
End If
For X = Start To Len(Str1) – Len(Str2) + 1
If Mid(” ” & Str1 & ” “, X, Len(Str2) + 2) _
Like Pattern & Str2 & Pattern Then
InStrExact = X
Exit Function
End If
Next
End Function
Hi Rick,
When I run the code as supplied by Leonid it adds spaces before and after the text in each cell, so you have to remove the
or the text gets a space added before and after it each time the code is run.
Additionally, I found the code did not work and I got results like this, which also show the space added at the start of each string,
when of course the results should look like this
The code as I modified it does work to find strings within strings, as shown here by the text in row 2, I didn’t say it had to be delimited by spaces.
Sorry I couldn’t get your function to work, it returned 0. But I found that just using
worked for case sensitive searches and
worked for case-insensitive searches.
You can also use Find() in the worksheet for case-insensitive searches.
Regards
Phil
Thanks, Catalin. I appreciate the prompt answer.
You’re wellcome Glenn 🙂
What is the purpose of the “$” after “Join”?
Hi Glenn,
It’s a data type declaration:
Data types:
@ – currency
# – double
% – integer
& – long
! – single
$ – string
Usually, functions without $ sign at the end of function name returns a Variant data type with subtype String, and the FunctionName$() functions returns a String data type.
This way, functions can be more efficient.
Catalin
Is it possible to highlight just a sequence of chararcters or partial word? For example, I would like to have only “pant” highlighted rather than the whole word “panther” or “ky” rather than “sky”.
Hi Mike,
Almost anything is possible, sorry for the late reply.
You can try this file from our OneDrive folder
The modified code is: (works with full or partial words)
Option ExplicitOption Compare Text
Sub ColorWords()
' Written by Philip Treacy, Sep 2014
' My Online Training Hub https://www.myonlinetraininghub.com/change-the-color-of-words-in-text
Dim MyWords, MyColors
Dim MyCell As Range, TargetRange As Range
Dim i As Integer
Dim TestStr As Long
MyWords = VBA.Array("Sky", "Grass", "Ruby", "Panth") 'Add to list as required
MyColors = VBA.Array(vbBlue, vbGreen, vbRed, vbMagenta) 'Add corresponding color to match MyWords list
Set TargetRange = ActiveCell.CurrentRegion
TargetRange.Font.ColorIndex = xlAutomatic
For Each MyCell In TargetRange.Cells
For i = LBound(MyWords) To UBound(MyWords)
TestStr = InStr(1, MyCell.Text, MyWords(i), vbTextCompare)
If TestStr Then MyCell.Characters(TestStr, Len(MyWords(i))).Font.Color = MyColors(i)
Next i
Next MyCell
End Sub
Sub ShowCurrentRegion()
ActiveCell.CurrentRegion.Select
End Sub
Thanks Catalin
I very much appreciate the reply. Your code worked well and I was able to adapt my specific case – however my need changed so will be unable to implement. never-the-less, I did learn something and may be able to implement in the future so a valuable exercise for me. Thanks again – it is good to know that help (and good help!) is just a question away. Have a good day.
You’re wellcome Mike 🙂
This tip has certainly drawn at lot of attention – it is a good one. I have another question – is it possible to highlight all occurrences of a word/phase/sequence of letters by entering the search criteria into worksheet cell rather than into the code?
Hi Mike,
Of course it’s possible, here is a version using a table containing keywords and colors, you can choose any color by typing a number from 1 to 56 in column J. The colors are listed in sheet3 of this file from our OneDrive folder.
The code:
Sub ColorWords()' Written by Philip Treacy, Sep 2014
' My Online Training Hub https://www.myonlinetraininghub.com/change-the-color-of-words-in-text
Dim KeyWords As Variant
Dim MyCell As Range, TargetRange As Range
Dim i As Integer
Dim TestStr As Long
KeyWords = Range("Keywords[[Keywords]:[Color Index]]") 'Add to list as required
Set TargetRange = ActiveCell.CurrentRegion
TargetRange.Font.ColorIndex = xlAutomatic
For Each MyCell In TargetRange.Cells
For i = 1 To UBound(KeyWords, 1)
TestStr = InStr(1, MyCell.Text, KeyWords(i, 1), vbTextCompare)
If TestStr Then MyCell.Characters(TestStr, Len(KeyWords(i, 1))).Font.ColorIndex = KeyWords(i, 2)
Next i
Next MyCell
End Sub
The only change is that we create the array, using a defined table range :
KeyWords = Range(“Keywords[[Keywords]:[Color Index]]”)
A range is a bidimensional array, by default, because we have rows and columns.
This is the reason that we search for values in column 1 of the table with KeyWords(i, 1), and return values from column 2 , that holds the color index: KeyWords(i, 2)
Hope it’s clear 🙂
Catalin
Beautiful work. Thank you for your contribution.
Thanks Jef