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.
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.
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.
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.
Option Explicit Option Compare Text Sub ColorWords() ' Written by Philip Treacy, Sep 2014 ' My Online Training Hub http://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