Select all Matching cells
 

I have a macro brings up a message box, asks for a word and then highlights
it. The table is sorted by the word, so it is in alphabetical order. I want
it to highlight all of the matching words when it finds them instead of just
the first word it finds in the column. Here is the macro I already have:

Sub Cusip()
'
' Cusip Macro
' Macro recorded 2/21/2008 by User
'

Dim wsSheet As Worksheet
Dim rFound As Range
Dim strFind As String
Dim iRow As Integer
Dim iCol As Integer

strFind = InputBox(Prompt:="Enter CUSIP")
If strFind = "" Then Exit Sub
For Each wsSheet In ThisWorkbook.Worksheets
'wsSheet.Range("K:K").EntireColumn.Hidden = True
Set rFound = wsSheet.UsedRange. _
Find(What:=strFind, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not rFound Is Nothing Then
Application.Goto rFound, Scroll:=True
'wsSheet.Range("K:K").EntireColumn.Hidden = False
iRow = ActiveCell.Row
'iCol = ActiveCell.Column
'Cells(iRow, 0).Select
'Range(iRow, 0).Select
Range(Selection, ActiveCell.Offset(0, 0)).Select

End
End If
'wsSheet.Range("K:K").EntireColumn.Hidden = False
Next wsSheet

MsgBox "No match"

End Sub


I hope this makes sense, thank you!