Joecruz749,
Welcome to the forum!
Attached is an example workbook based on the criteria you described.
It contains two worksheets: 'Query' (where the query cell is contained and the results will be displayed) and 'Data' (where the table of data is located)
In sheet 'Query', cell B2 is where you enter the text that will be searched for. The results will begin in A5 and go down from there. There is a button labelled "Get Results" which is assigned to the following macro:
Sub QueryData()
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim rngFound As Range
Dim rngCopy As Range
Dim strFirst As String
Dim strQuery As String
Dim rIndex As Long
Dim lLastRow As Long
Set wsData = Sheets("Data")
Set wsDest = Sheets("Query")
strQuery = LCase(wsDest.Range("B2").Text)
lLastRow = wsData.Cells.Find("*", wsData.Range("A1"), , , , xlPrevious).Row
wsDest.Range("A5", wsDest.Cells(Rows.Count, Columns.Count)).ClearContents
Application.ScreenUpdating = False
Set rngFound = wsData.UsedRange.Find("*" & strQuery & "*", wsData.UsedRange.Cells(wsData.UsedRange.Cells.Count), xlValues, xlWhole)
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Set rngCopy = rngFound.EntireRow
Do
Set rngCopy = Union(rngCopy, rngFound.EntireRow)
Set rngFound = wsData.UsedRange.Find("*" & strQuery & "*", rngFound, xlValues, xlWhole)
Loop While rngFound.Address <> strFirst
rngCopy.EntireRow.Copy wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
Else
MsgBox "No rows found to contain [" & strQuery & "]", , "No Matches"
End If
Application.ScreenUpdating = True
Set wsData = Nothing
Set wsDest = Nothing
Set rngFound = Nothing
Set rngCopy = Nothing
End Sub
Bookmarks