Try something like this...
Sub SearchMe()
Dim rFoundCell As Range, FirstFound As String
Application.ScreenUpdating = False
Set rFoundCell = Cells.Find(What:="UOM", After:=Range("H5"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not rFoundCell Is Nothing Then
FirstFound = rFoundCell.Address
Do
UserForm2.Show
With rFoundCell
End With
Set rFoundCell = Cells.FindNext(After:=rFoundCell)
Loop Until rFoundCell.Address = FirstFound
End If
Application.ScreenUpdating = True
End Sub
Bookmarks