Solved Excel Macro to color certain words in a line of text

October 12, 2014 at 04:58:14
Specs: Windows 7
I have a list of banned words which I have named "content_check" and are in a tab called "Guide". I want to make a macro which will check cells G13, G15, G19, G21 and E30:E6000 (if not blank) in the tab "A+_Creation" and highlight in red any words which match those in the banned words list.

I'm currently using conditional formatting which turns any cells which contain a banned word red, but given that the list contains almost 400 words it would be much better if only the word turned red instead of the whole cell.

Would anyone know how to go about this or if there is a forum that has already covered this? I have basic knowledge of macros, but it's not advanced enough for something like this.

Any help would be hugely appreciated!

See More: Excel Macro to color certain words in a line of text

Report •

October 12, 2014 at 09:54:40
A couple of questions just for clarification...

Could you give us an example of what is in the cells that need to be checked? Are they sentences, lists, etc?

Could there be more than one banned word in a given cell or is it a case of "Once a banned word is found, we can move on to the next cell."

If there are any other details you think we need, please provide them. Thanks.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

October 12, 2014 at 17:12:34
✔ Best Answer
OK, I decided to play a little bit while waiting for your answers.

The following code assumes the Ranges on A+_Creation contain "sentences" such as:

The cow is brown.
The yellow bird is small.
The red house has a brown roof and brown shutters.

Let's say your Banned Words are:


The following code should result in:

The cow is brown.
The yellow bird is small.
The red house has a brown roof and brown shutters.

Let me know if this works for you or if I have misunderstood your requirements.

Sub ColorMyWord()
''With all due respect to Chicago

'Turn off screen updating to speed up code
 Application.ScreenUpdating = False

'Set Range to search
  With Sheets("A+_Creation").Range("G13,G15,G19,G21,E30:E6000")

'Loop through Banned Words list
   For Each word In Sheets("Guide").Range("content_check")

'Find cells with at least one Banned Word
    Set w = .Find(word, lookat:=xlPart)
     If Not w Is Nothing Then
      firstAddress = w.Address

'Find Banned Word within cell, force uppercase
'to eliminate case sensitivity
         bWordStart1 = InStr(1, UCase(w), UCase(word))

'Set Banned Word font color to Red
          w.Characters(Start:=bWordStart1, _
                       Length:=Len(word)).Font.ColorIndex = 3

'Set up variable to search for more Banned Words within same cell
            bWordStart_nxt = bWordStart1 + 1

'Search for more Banned Words in same cell, color each one red
               bWordStart_n = InStr(bWordStart_nxt, UCase(w), UCase(word))
                 If bWordStart_n > 0 Then
                   w.Characters(Start:=bWordStart_n, _
                                Length:=Len(word)).Font.ColorIndex = 3
                    bWordStart_nxt = bWordStart_n + 1
                 End If
             Loop While bWordStart_n <> 0

'Search for next cell with same Banned Word
          Set w = .FindNext(w)
        Loop While Not w Is Nothing And w.Address <> firstAddress
     End If

'Begin Search for next Banned Word in list
 End With
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03

Report •

October 13, 2014 at 13:37:35
Hi Derbydad03,

Thank you for your reply, I tried the code but unfortunately it hasn't worked for me. However, the following code has worked:

Sub ColorCertainWords()
  Dim Z As Long, Position As Long, Words As Variant, Cell As Range
  Words = Range("content_check")
  For Each Cell In Sheets("A+_Creation").Range("G13,G15,G19,G21,E30:E6000")
    If Len(Cell.Value) Then
        For Z = 1 To UBound(Words)
          Position = InStr(1, Cell.Value, Words(Z, 1), vbTextCompare)
          Do While Position
            Cell.Characters(Position, Len(Words(Z, 1))).Font.ColorIndex = 3  'Red
            Position = InStr(Position + 1, Cell.Value, Words(Z, 1), vbTextCompare)
    End If
  End Sub

This was made by Rick Rothstein at, so all credit should go to him.

Thank you very much for your help though!

Report •

Related Solutions

October 13, 2014 at 13:56:09
That's interesting because I was able to use my code turn over 48,000 words "red" using a set of 400 "banned words" in the Guide sheet and over 6000 cells containing up to 8 banned words per cell in the A+_Creation ranges you specified. The total run time was about 5 seconds.

I then ran Mr. Rothstein's code against the same data and the results were exactly the same and in the same amount of time. I did nothing to change the data or the setup, I simply pasted Mr. Rothstein's code into a VBA module and ran it.

Why my code doesn't work for you yet both Mr. Rothstein's and mine produce the exact same results for me is a mystery.

In any case, I'm glad you found a solution

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

October 17, 2014 at 07:47:45

this code is excellent, i can confirm it worked for me too!

Report •

October 17, 2014 at 11:48:19
Thanks for that confirmation.

Sure would like to know why it didn't work for western077...

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

Report •

January 28, 2015 at 10:44:11
I have a similar need. I need to find and turn red 86 terms in text found in 4018 rows of cells in one column. I have tried using this code from DerbyDad03 that was posted on another, closed thread.

Option Explicit
Sub ColorWord()
Dim A_row, B_row, lstA_row, lstB_row, A_len, chr_num
'Find Last row of data in each list
lstA_row = Range("A" & Rows.Count).End(xlUp).Row
lstB_row = Range("B" & Rows.Count).End(xlUp).Row
'Loop through A1:A100
For A_row = 1 To lstA_row
'Check B1:B100
For B_row = 1 To lstB_row
'Does B cell contain word from A cell?
If Cells(B_row, 2) Like "*" & Cells(A_row, 1) & "*" Then
'Find length of word
A_len = Len(Cells(A_row, 1))
'Loop through string in B to find word from A
For chr_num = 1 To Len(Cells(B_row, 2)) - Len(Cells(A_row, 1)) + 1
If Mid(Cells(B_row, 2), chr_num, A_len) = Cells(A_row, 1) Then
'When found, turn word Red
Cells(B_row, 2).Characters(Start:=chr_num, Length:=A_len).Font.ColorIndex = 3
End If
End If
End Sub

The challenge I am encountering is that it is not working consistently. It is finding and changing some occurrences of the terms, but not all of them. (It is not a matter of case sensitivity.) Do you have an idea as to why this could be happening? This was originally written for Excel 2007 and I am using 2010. Could that be the difference?

Or could you please show me how to modify the code used by western077 to do what I need to do? (If this is not the correct place to post this, please let me know and I'll post it elsewhere. I'm new to this site!)

Thank you!

Report •

January 28, 2015 at 11:40:54
First a posting tip:

Please click on the blue line at the bottom of this post and read the instructions on how to post VBA code and/or example data in this forum. Thanks!

There is no way for us to know why the code isn't working consistently for you without knowing more about the way your spreadsheet is set up. VBA code is typically written based on very specific requirements and usually can not be simply re-used "generically".

Unless the list of "terms" you are searching for is in Column A and your actual data (that which is being searched and highlighted) is in Column B, the code won't work.

Without knowing more about your layout, there is not much we can offer.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03

Report •

January 28, 2015 at 12:56:11
My apologies for not pasting the code in properly! I guess I did not understand what the blue line was telling me to do.

I believe I have determined that my issue was that I was trying too hard to customize the code to match the column locations in my worksheet--the text is in column I (aka 9) and the search terms are in column AR (aka 44). When I tried it again by copying those columns into a new worksheet to B and A respectively and just adjusting the number of rows to 4018 and 86, it worked fine. I'll use this as a workaround to get it done.

Thank you so much for your help and for creating something that does what we thought was impossible!

Report •

Ask Question