Sub FindAll()
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim TextBox1 As TextBox
fnd = Sheets("Sheet1").TextBox1.Value
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
Do Until FoundCell Is Nothing
Set FoundCell = myRange.FindNext(after:=FoundCell)
Set rng = Union(rng, FoundCell)
If FoundCell.Address = FirstFound Then Exit Do
Loop
rng.Select
Exit Sub
NothingFound:
MsgBox "No values were found in this worksheet"
End Sub