PDA

View Full Version : multiple string search at sametime



weparle
12-15-2007, 07:40 AM
i have a search program develop, however I want to be able to submit multiple words at the same time and the code will search any word separately. here is my code

Sub FindStrings()
Dim FirstCell As Range, NextCell As Range
Dim stringToFind As String
Dim NextRow As Long
Dim Column As Long
' Show an input box and return the entry to a variable.
stringToFind = _
Application.InputBox("Enter Keyword", "Search Treatment")
' Set an object variable to evaluate the Find command.
Set FirstCell = Cells.Find(what:=stringToFind, _
lookat:=xlPart, _
searchdirection:=xlNext)
' If the string is not found, show this message box.
NextRow = 0
If FirstCell Is Nothing Then
MsgBox "Search Value Not Found.", vbExclamation
Else
Set NextCell = FirstCell
Do
' Otherwise, find the next occurrence of the search text.
Set NextCell = _
Cells.FindNext(NextCell)
If Not NextCell Is Nothing And _
FirstCell.Address <> NextCell.Address Then

NextRow = NextRow + 1
Worksheets("Results").Cells(NextRow + 1, "A").Value = NextCell
Worksheets("Results").Cells(NextRow + 1, "B").Value = NextCell.Offset(0, 1).Value
Worksheets("Results").Cells(NextRow + 1, "C").Value = NextCell.Offset(0, 2).Value
Worksheets("Results").Cells(NextRow + 1, "D").Value = NextCell.Offset(0, 3).Value
Worksheets("Results").Cells(NextRow + 1, "E").Value = NextCell.Offset(0, 4).Value
Worksheets("Results").Cells(NextRow + 1, "F").Value = NextCell.Offset(0, 5).Value
End If
Loop Until NextCell Is Nothing Or _
FirstCell.Address = NextCell.Address
End If
End Sub

XLGibbs
12-15-2007, 02:00 PM
DUPE: http://vbaexpress.com/forum/showthread.php?t=16720