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.
Option Explicit
Option 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 MatchPosition As Long
Dim MyPattern As String
Dim MyCell As Range, TargetRange As Range
Dim MyObj As Object
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
MyPattern = Join$(MyWords, Chr(2))
With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
.Pattern = "([\^\$\(\)\[\]\*\+\-\?\.\|])"
MyPattern = Replace(.Replace(MyPattern, "\$1"), Chr(2), "|")
.Pattern = "\b(" & MyPattern & ")\b"
For Each MyCell In TargetRange.Cells
If .test(MyCell.Value) Then
For Each MyObj In .Execute(MyCell.Value)
MatchPosition = Application.Match(MyObj, MyWords, 0)
If Not IsError(MatchPosition) Then
MyCell.Characters(MyObj.firstindex + 1, MyObj.Length).Font.Color = MyColors(MatchPosition - 1)
End If
Next
End If
Next MyCell
End With
End Sub
Sub ShowCurrentRegion()
ActiveCell.CurrentRegion.Select
End Sub
Please Share
If you know someone who could use this please click the buttons below to share it on Google+, LinkedIn, Facebook and Twitter.
Djim says
Some piece of code this is!!!
I was looking for this for a very long time. Well done to all involved.
Philip Treacy says
Thanks Djim, glad it was useful to you.
Phil
Mike says
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.
Catalin Bombea says
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
Mike says
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!
Catalin Bombea says
Glad to hear that it works as you wanted 🙂
You’re wellcome
Catalin
Leonid Koyfman says
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 SubPhilip Treacy says
Hi 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 SubRick Rothstein (MVP - Excel) says
You 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
Philip Treacy says
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
Glenn Case says
Thanks, Catalin. I appreciate the prompt answer.
Catalin Bombea says
You’re wellcome Glenn 🙂
Glenn Case says
What is the purpose of the “$” after “Join”?
Catalin Bombea says
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
Mike says
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”.
Catalin Bombea says
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
Mike says
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.
Catalin Bombea says
You’re wellcome Mike 🙂
Mike says
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?
Catalin Bombea says
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
jef says
Beautiful work. Thank you for your contribution.
Philip Treacy says
Thanks Jef