Thread: VBA to find and select text within text and highlight

I have adopted code from this forum to find all cells with text that matches user-entered text and which opens the color palette so users can choose the color to highlight that text. However, while the code does all this very well, it does not find text within text. The built-in Excel search function does find text within text, and that it what I am trying to get the code to do, with the additional benefit of highlighting that text (or at least the cell in which it is contained). I cannot figure out how to get the VBA search to work when the search text has at least one other character or number in the cell.

This is the code I have:

Sub HighlightCellsChooseColor()

'This will search the entire workbook for all instances of the search text.
'It will highlight each instance in your choice of color. This search is
'not case-sensitive, but it will not locate search text if its cell
'contains other text,including a formula."

Dim i As Long
Dim Fnd As String
Dim fCell As Range
Dim ws As Worksheet
Dim Color As Integer
Dim rngCurr As Range

Fnd = InputBox("Enter text to search" & vbCr & vbCr _
       & "Click OK to search the entire workbook for all instances of the search text.  Each instance will be highlighted in yellow. This search is not case-sensitive, but it will not locate search text if its cell contains other text, including a formula.")

If Fnd = vbNullString Then
           Exit Sub
End If

Application.ScreenUpdating = False
Application.Dialogs(xlDialogPatterns).Show 'shows color palette
Color = ActiveCell.Interior.ColorIndex 'stores index number of selected color
ActiveCell.Interior.ColorIndex = xlNone 'since previous line colors cell where cursor pointer is, this removes the shading from that cell

Application.ScreenUpdating = True

For Each ws In Worksheets
    With ws
        Set fCell = .Range("A1")
        For i = 1 To WorksheetFunction.CountIf(.Cells, Fnd)
            Set fCell = .Cells.Find(What:=Fnd, After:=fCell, LookIn:=xlValues, _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, MatchCase:=False)
            If fCell Is Nothing Then
                MsgBox Fnd & " not on sheet !!"
                Exit For
            Else
   
               With fCell
                    .Interior.ColorIndex = Color 'applies color user selected from palette
               End With
            End If
        Next i
    End With
Next ws
End Sub