Macro to highlight/Bold multiple words in excel at once

[isenhour]

Hi Guys;

• I need some expert help...Please

• I have a program here that will search through a specific "Range" of data for a single word and format that word accordingly.

• This program works fanatically if I'm just searching for a word or two b/c this program provides a "pop-up" box for the user to enter in the word, but I would like to search for multiple words at once instead of having to enter in 30+ words one at a time.

Question:

• How can i search for more then one word at a time?
• Is there a way to put my values into an array and have it work with the below code. ?

search values = "best", "profit", 'cash"

-------------------------------------------------------------

Public Sub WordFormatting()


Dim xFind As String
Dim xCell As Range
Dim xTxtRg As Range
Dim xCount As Long
Dim xLen As Integer
Dim xStart As Integer
Dim xRg As Range
Dim xTxt As String


On Error Resume Next

If ActiveWindow.RangeSelection.Count > 1 Then
xTxt = ActiveWindow.RangeSelection.AddressLocal
Else
xTxt = ActiveSheet.UsedRange.AddressLocal
End If


'' Pop-up box asking user to specify range''
Set xRg = Application.InputBox("Please select data range:", "Select Specific Range", xTxt, , , , , 8)


If xRg Is Nothing Then Exit Sub

On Error Resume Next

Set xTxtRg = Application.Intersect(xRg.SpecialCells(xlCellTypeConstants, xlTextValues), xRg)
If xTxtRg Is Nothing Then
MsgBox "There are no cells with text"
Exit Sub
End If


''Pop-up box asking you for key words
xFind = Trim(Application.InputBox("What do you want to BOLD and Italic?", "Search Words", , , , , , 2))


If xFind = "" Then
MsgBox "No text was listed, please try again", vbInformation, "Nothing Entered into Search"
Exit Sub
End If


xLen = Len(xFind)

''Formatting of specific words''
For Each xCell In xTxtRg
xStart = InStr(xCell.Value, xFind)

Do While xStart > 0
xCell.Characters(xStart, xLen).Font.Bold = True
xCell.Characters(xStart, xLen).Font.Italic = True
xCell.Characters(xStart, xLen).Font.Underline = True
xCell.Characters(xStart, xLen).Font.Color = RGB(255, 0, 0)
xCount = xCount + 1
xStart = InStr(xStart + xLen, xCell.Value, xFind)
Loop
Next

''Message informs user of the number of items changed''
If xCount > 0 Then
MsgBox "There where " & CStr(xCount) & " items formatted!", vbInformation, "Results"
Else
MsgBox "Unable to find the specific text!", vbInformation, "No Results"
End If


End Sub