automatically underline certain key words in all cells in a column

[skyport]

Was hoping there is a chance this can actually be done with some sort of VBA -automatically underline certain key words in all cells in a column

 

[Peter_SSs]

Hi Peter,

thanks for the previous help, but lets say I would want to make the specific words in capital letters instead of underline. How would I need to modify the macro to do this?

I've been away for quite a while, but if you are still looking, see if this does what you want.

Sub CapitaliseKeyWords()
  Dim AllMatches As Object
  Dim itm As Variant
  Dim Cell As Range
  Dim lr As Long
  Dim s As String

  Const myCols As String = "G:I"
  
  Application.ScreenUpdating = False
  lr = Columns(myCols).Find(What:="*", After:=Columns(myCols).Cells(1), LookIn:=xlValues, SearchDirection:=xlPrevious).Row
  With CreateObject("VBScript.RegExp")
    .Global = True
    .IgnoreCase = True
    .Pattern = "\b(" & Join(Application.Transpose(Sheets("Words").Range("A1", Sheets("Words").Cells(Rows.Count, "A").End(xlUp)).Value), "|") & ")\b"
    For Each Cell In Columns(myCols).Resize(lr).Cells
        s = LCase(Cell.Value)
        Set AllMatches = .Execute(s)
        For Each itm In AllMatches
          s = Left(s, itm.firstindex) & UCase(itm) & Mid(s, itm.firstindex + itm.Length + 1)
        Next itm
        Cell.Value = s
    Next Cell
  End With
  Application.ScreenUpdating = True
End Sub