Find and underline specific words in a column 1

[Greyhound1]

Objective: Search Column"P" within an Excel worksheet for constant stringwords (regardless of case), and upon finding those stringwords, underline only the stringword in the cell and set the textfont to RED, leaving other words within the cell black. If not found then use the default black text color.
Criteria: Need to find the following string words: rail, Rail, ins, inside, Inside, wide, Wide, wd, closed, fade, faded, bumped, bmped, Collided.
Obstacles: Excel's FIND only searches for one word. Also, there are more words than a nested "IF" statement allows. Further, the words are not always in the same position in the phrase.
Sample phrase: Even rail run
Desired phrase: Even rail run

 

[NigelHarper]

Greyhound1

The only way to do this is via VBA. Say you have a workbook with two sheets in. One is called "DataSheet" which holds your cells containing the text where you want to hunt down words and underline them, and the other is "ListofWords" which contains cells holding text values that are the words you want to hunt down and format on the sheet "DataSheet".

Hit Alt + F11 and the Visual Basic editor will open. Make sure that your Workbook is highlighted in the Project window and then go to Insert on the Menu Bar and choose Module. Double-click the newly inserted module under Modules in your Project window and copy and paste in the text below between the hyphenlines. Once you have done that you will then be able to go back to your workbook and on to the sheet "DataSheet" and from the Tools menu select Macro and run the Underline macro. Voila! I hope this helps.
NigelHarper
'---------------
Dim intCellLength As Integer
Dim intStart As Integer
Dim strWord As String

Sub UnderlineRed()
Application.ScreenUpdating = False
For Each Value In Worksheets("ListofWords&quot.Cells.SpecialCells(xlConstants)
If Value.Value <> &quot;&quot; Then
strWord = Value.Value
End If
For Each cell In Worksheets(&quot;DataSheet&quot.Cells.SpecialCells(xlConstants)
If cell.Value <> &quot;&quot; Then
intCellLength = Len(cell.Value)
For intStart = 1 To intCellLength
If Mid(cell.Value, intStart, Len(strWord)) = strWord Then
With cell.Characters(Start:=intStart, Length:=Len(strWord)).Font
.Underline = xlUnderlineStyleSingle
.ColorIndex = 3
End With
End If
Next intStart
End If
Next cell
Next Value
End Sub
'---------------

 

[Greyhound1]

Thanks, Nigel

I have saved a copy, and really appreciate the codescript.

Stephen

 

[SkipVought]

Hi
1. set up a list of the strings you want to search for and name the range - I named it SearchString

2. here's the code

Sub SearchForStrings()
    Dim rng As Range, sValue As String
    Dim cell1 As Range, cell2 As Range
    Dim iLen1 As Integer, iLen2 As Integer
    'you column range
    Set rng = Range("E:E")
    
    For Each cell1 In rng
        With cell1
            iLen1 = Len(cell1.Value)
            For i = 1 To iLen1
                For Each cell2 In Range("SearchString")
                    iLen2 = Len(cell2.Value)
                    If Mid(.Value, i, iLen2) = cell2.Value Then
                        With cell1.Characters(Start:=i, Length:=iLen2).Font
                            .Underline = xlUnderlineStyleSingle
                            .ColorIndex = 3
                        End With
                    End If
                Next
            Next
        End With
    Next
End Sub

skip

 

[Greyhound1]

Thanks folks,
The code worked great, after defining &quot;i&quot;. I appreciate the codes very much!!!!!!

Thanks again,

Stephen