Making specific text in range of cells bold.

[chipgiii]

I have a Project Spreadsheet with multiple projects. Column F contains the Project Descriptions. In column F there are often one or more of the following: "Prior Description," "No Description," or "New Description." I would like to make the quoted text bold. Here is an example of one cell.

Prior Description: Additional 3000 m2 of new, high quality glasshouses for high throughput phenotyping to support GM activities in ABCD. New Description: What’s driving it: ABCD ABCD plan. Please check with Frank. We are suspending planning for ABCD at this point.
What it accomplish: n.a.
Why that’s important: n.a.

Above is how I want it to look. Presently none of the text is bold. There are several thousand projects and some added daily so going cell by cell is very time consuming. I have tried every formatting trick I know and zilch. VBA is not my thing, but I suspect if there is a solution, that's where it will be.

[pike]

Hi chipgiii
all depends on the content and layout of the text but try..

Option Explicit
Sub HighlightCells()
    Dim Lookin As Range, ff As String
    Dim i As Long
    Dim Fnd As Variant
    Dim fCell As Range
    Dim ws As Worksheet
    Dim xItem As Variant
    
    Fnd = Array("Prior Description", "No Description", "New Description")
    For Each ws In Worksheets
        With Sheets(ws.Name)
            For Each xItem In Fnd
                Set Lookin = .Cells.Find(xItem, Lookin:=xlValues, LookAt:=xlPart)
                If Not Lookin Is Nothing Then
                    ff = Lookin.Address
                    Do
                       Lookin.Characters(InStr(1, Lookin, xItem), Len(xItem)).Font.Bold = True
                        Set Lookin = .Cells.FindNext(Lookin)
                    Loop Until ff = Lookin.Address
                End If
                Set Lookin = Nothing
            Next
        End With
    Next
End Sub

[pike]

or

Option Explicit
Sub BoldWords()
    Dim Match, ws As Worksheet
    Dim rng As Range
    With CreateObject("vbscript.regexp")
    For Each ws In Worksheets
        For Each rng In ws.UsedRange
            .Pattern = "(Prior Description|No Description|New Description)"
            .IgnoreCase = False
            .Global = True
            If .test(rng.Text) = True Then
                For Each Match In .Execute(rng.Text)
                    rng.Characters(Match.FirstIndex + 1, Match.Length).Font.Bold = True
                Next
            End If
        Next
    Next
    End With
End Sub

[snb]

Or

Sub M_snb()
    sn = Filter([transpose(If(iserr(search("description",F1:F1000)),"~",row(F1:F1000)))], "~", 0)
    
    For j = 0 To UBound(sn)
        Cells(sn(j), 6).Characters(1, InStr(Cells(sn(j), 6), "description") + 11).Font.Bold = True
    Next
End Sub

[pike]

missed that bit just in any worksheet and in column f
repeated and multiple occurances of "Prior Description" and/or "No Description" and/or "New Description"

Option Explicit
Sub BoldWords()
    Dim Match, ws As Worksheet
    Dim rng As Range
    With CreateObject("vbscript.regexp")
    For Each ws In Worksheets
        For Each rng In ws.Range("F1", ws.Cells(Rows.Count, 6).End(xlUp))
            .Pattern = "(Prior Description|No Description|New Description)"
            .IgnoreCase = False
            .Global = True
            If .test(rng.Text) = True Then
                For Each Match In .Execute(rng.Text)
                    rng.Characters(Match.FirstIndex + 1, Match.Length).Font.Bold = True
                Next
           End If
        Next
    Next
    End With
End Sub

[chipgiii]

I was out for a few days and just tried this one. Works perfectly! I will try some of the others as well. Thanks a million, and I am very impressed!

[pike]

thanks for posting it was an interesting question