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