Macro to bold and change font of specific words in cells in Excel

[jgarner123]

I have a list of words that I need to bold and change the color. For example,

gross proceeds needs to be bold and red
market value needs to be bold and red
enhancing the value needs to be bold and blue
used off needs to be bold and green

I only need exact matches. Also these words can appear multiple times in the same cell. I have used a code that only changes the words the first time they are in the cell - the words might be in the same cell 5 times but only the first instance is fixed. Also this code is only for one specific example so I have to change it and run it several times. I would like to just run it once. In addition to the above 4 examples I have about 30 other combinations.

The code I have used is below:

Sub colorText()

Dim cl As Range

Dim startPos As Integer

Dim totalLen As Integer

Dim searchText As String



' specify text to search. (Change to your needs)

' searchText = [A1]

' searchText = Application.InputBox("enter search text")

searchText = "market value"



' loop trough all cells in selection/range (Change to your needs)

'For Each cl In Range("b:b")

'For Each cl In Selection

'For Each cl In Range("b1", Range("b65536").End(xlUp))

For Each cl In Range("b1:b222")



totalLen = Len(searchText)

startPos = InStr(cl, searchText)



If startPos > 0 Then

With cl.Characters(startPos, totalLen).Font

.FontStyle = "Bold"

.ColorIndex = 10

End With

End If

Next cl

End Sub

 

[jgarner123]

Hey - thanks!! Yes - the code your wrote works great!!! I was just hoping that I could find a way to put the words like "gross proceeds, market value, etc. in a separate worksheet and reference that range in the macro. However, yours works great and will save me a TON of time. Thanks so much!!!!

 

[Rick Rothstein]

Hey - thanks!! Yes - the code your wrote works great!!! I was just hoping that I could find a way to put the words like "gross proceeds, market value, etc. in a separate worksheet and reference that range in the macro. However, yours works great and will save me a TON of time. Thanks so much!!!!

I can modify the code to do that if you want (and think you will be changing the text values, and/or their colors, often enough to need that flexibility)... just tell me the sheet name and cell address for the first "word".

 

[jgarner123]

okay - first of all you rock!!! the sheet name where the edits will take place is "Clauses" column b. the sheet name with the words that need to be included is "Lists". in Lists, column A has the word that need to be read and those words start in A3 and I estimate that they will go from A3 to A30. Words that need to be green in B3:B30, and blue in C3:C30. thanks so much!!!

 

[Rick Rothstein]

okay - first of all you rock!!! the sheet name where the edits will take place is "Clauses" column b. the sheet name with the words that need to be included is "Lists". in Lists, column A has the word that need to be read and those words start in A3 and I estimate that they will go from A3 to A30. Words that need to be green in B3:B30, and blue in C3:C30. thanks so much!!!

Okay, give this code a try...

Sub ColorCertainWords()
  Dim X As Long, Z As Long, LastRow As Long, Position As Long, Colors(1 To 3) As Long
  Dim Temp As String, Words As Variant, Cell As Range
  
[COLOR=#0000ff][B]  Const Red As Long = 3
  Const Green As Long = 4
  Const Blue As Long = 5[/B][/COLOR]
  
  Colors(1) = Red
  Colors(2) = Green
  Colors(3) = Blue
  
  For Each Cell In Sheets("Clauses").Range("B1", Sheets("Clauses").Cells(Rows.Count, "B").End(xlUp))
    If Len(Cell.Value) Then
      For X = 1 To 3
        LastRow = Sheets("Lists").Cells(Rows.Count, X).End(xlUp).Row
        Words = Range(Sheets("Lists").Cells(3, X), Sheets("Lists").Cells(LastRow, 3))
        If Not IsArray(Words) Then
          Temp = Words
          ReDim Words(1 To 1, 1 To 1)
          Words(1, 1) = Temp
        End If
        For Z = 1 To UBound(Words)
          Position = InStr(1, Cell.Value, Words(Z, 1), vbTextCompare)
          Do While Position
            With Cell.Characters(Position, Len(Words(Z, 1))).Font
              .ColorIndex = Colors(X)
              .Bold = True
            End With
            Position = InStr(Position + 1, Cell.Value, Words(Z, 1), vbTextCompare)
          Loop
        Next
      Next
    End If
  Next
  
End Sub

I had to change the structure of the code from that which I posted earlier... the blue highlighted part is where you would change the ColorIndex values for the colors in case you wanted different shades of red, green and/or blue.

 

[jgarner123]

Absolutely perfect!!!! Thanks so much!!