Sub Test()

BoldWord ActiveSheet, "my-word"

End Sub


Sub BoldWord(ws As Worksheet, sWord As String)
Dim pos As Long
Dim firstAddress As String
Dim vBold
Dim rng As Range
Dim cel As Range

On Error Resume Next
Set rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants , 2)
On Error GoTo 0
If rng Is Nothing Then Exit Sub

With rng

Set cel = .Find(what:=sWord, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not cel Is Nothing Then
firstAddress = cel.Address
Do
pos = InStr(1, cel.Value, sWord)
While pos
vBold = cel.Characters(pos, Len(sWord)).Font.Bold
If vBold = vbNull Then vBold = False
If Not vBold Then
cel.Characters(pos, Len(sWord)).Font.Bold = True
End If

pos = InStr(pos + 1, cel.Value, sWord)
Wend

Set cel = .FindNext(cel)
Loop While Not cel Is Nothing And cel.Address < firstAddress

End If
End With

End Sub

Regards,
Peter T

"suestew" wrote in message
...
How do I do it?