Help with macro to bold word

Hello,

The code below bolds the string entered in an input box. I require some help to make a change.

Currently the code will bold the entered characters whether it is a whole word or part of a word. I would like to bold the whole word only. For example, if I enter the word ?in? I would only like all of the instances in the sheet of the word ?in? bolded not the letters ?in? bolded within a word.

Regards,

Ron

Code:

---

Sub MakeWordBold()
Dim strSearch As String
Dim searchRng As Range
Dim i As Long
Dim cel As Range
Dim LastRow As Integer
Dim LastCol As Integer
Dim Found As Boolean
Application.ScreenUpdating = False
LastRow = ActiveSheet.UsedRange.Rows.Count
LastCol = (ActiveSheet.UsedRange.Columns.Count) - 1
Set searchRng = Range(Cells(1, 1), Cells(LastRow, LastCol))
strSearch = InputBox("Please enter the text to make bold:", "Bold Text")
If strSearch = "" Then
    Exit Sub
End If
For Each cel In searchRng
    With cel
        .Font.Bold = False
        For i = 1 To Len(.Text) - Len(strSearch) Step 1
            If Mid(.Text, i, Len(strSearch)) = strSearch Then
                .Characters(i, Len(strSearch)).Font.Bold = True
                Found = True
            End If
        Next i
    End With
Next cel
If Found = False Then
    MsgBox "No match found.", vbOKOnly
Else
    MsgBox "Complete.", vbOKOnly
End If
Application.ScreenUpdating = True
End Sub

---

Hi Ron,
Have a look at the following. It may need a bit more development, but it's getting late here.

Code:

---

Option Compare Text
Sub MakeWordBold()
Dim strSearch As String
Dim searchRng As Range
Dim i As Long
Dim cel As Range
Dim LastRow As Integer
Dim LastCol As Integer
Dim Found As Boolean
Dim StrLen As Long
Application.ScreenUpdating = False
'Create range to allow union command below
Set searchRng = Range("A1")
strSearch = InputBox("Please enter the text to make bold:", "Bold Text")
StrLen = Len(strSearch)
With ActiveSheet.UsedRange
Set c = .Find(strSearch, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Set searchRng = Union(searchRng, c)
Set c = .FindNext(c)
Debug.Print c.Address(0, 0)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
searchRng.Interior.ColorIndex = 6
For Each cel In searchRng
MyPos = InStr(1, cel, strSearch)
Debug.Print cel.Address
If MyPos <> 0 Then
Select Case MyPos
'Check at start
Case Is = 1
cel.Font.Bold = False
If Left(cel & " ", StrLen + 1) = strSearch & " " Then _
cel.Characters(MyPos, StrLen).Font.Bold = True
'Check at end
Case Is = Len(cel) - StrLen + 1
If Right(cel, StrLen + 1) = " " & strSearch Then _
cel.Characters(MyPos, StrLen).Font.Bold = True
'Must be in middle - might it occur more than once?
'What about punctuation? eg text,
Case Else
tmp = Mid(cel, MyPos - 1, StrLen + 2)
If Mid(cel, MyPos - 1, StrLen + 2) = " " & strSearch & " " Then _
cel.Characters(MyPos, StrLen).Font.Bold = True
End Select
End If
Next cel
Application.ScreenUpdating = True

---

it seemed to me that you wanted to test WHOLE words and not just character strings. I edited you code slightly adding a call to a proc (MWE_WordCount2) I wrote a while ago that parses a test string for whole words and returns the # found and an integer array of start/end locations. I then tested the target string against each whole word found in the cell. Seems to work.

Code:

---

Sub MakeWordBold2()
Dim strSearch As String
Dim searchRng As Range
Dim i As Long
Dim cel As Range
Dim LastRow As Integer
Dim LastCol As Integer
Dim Found As Boolean
Dim Words(25, 2) As Integer, NW As Integer
Application.ScreenUpdating = False
LastRow = ActiveSheet.UsedRange.Rows.Count
' LastCol = (ActiveSheet.UsedRange.Columns.Count) - 1
LastCol = (ActiveSheet.UsedRange.Columns.Count)
Set searchRng = Range(Cells(1, 1), Cells(LastRow, LastCol))
strSearch = InputBox("Please enter the text to make bold:", "Bold Text")
If strSearch = "" Then
Exit Sub
End If
For Each cel In searchRng
With cel
.Font.Bold = False
Call MWE_WordCount2(.Text, NW, Words)
For i = 1 To NW
If Mid(.Text, Words(i, 1), Words(i, 2) - Words(i, 1) + 1) = strSearch _
Then
.Characters(Words(i, 1), Len(strSearch)).Font.Bold = True
Found = True
End If
Next i
End With
Next cel
If Found = False Then
MsgBox "No match found.", vbOKOnly
Else
MsgBox "Complete.", vbOKOnly
End If
Application.ScreenUpdating = True
End Sub

---