Help with macro to bold word

[ron]

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

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

[mdmackillop]

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

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

[MWE]

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.

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