Macro for Search

[Brigette]

I need a macro that will search one sheet and return a copy of the row on
another sheet using multiple search criteria...
I have a spreadsheet that logs data on one sheet called "Design Review Log".
That sheet has 8 columns. The headers are "Description, #, Seat Model,
Type, Customer Code, Date, Job #, Open/Closed.

I have another sheet called "Search" where I want to create a search feature
using a macro that can search by multiple criteria. I have placed the same
headers in row 2 and using row 3 to enter the criteria.

For example, I may want to search for a specific Customer code and Job #.
If there are any rows on "Design Review Log" that meets both criteria it will
copy and paste the rows on the "Search" sheet. I want to be able to search
using 1 criteria or up to all 8. If I do another search, I want it to clear
the first search results and copy and paste the new results.

 

[Dave Peterson]

It sounds like you're recreating data|filter|autofilter in excel.

You could apply data|filter|autofilter to your data, then use those dropdown
arrows to "search" each field for what you want.

I wouldn't copy them to any other sheet--I'd just leave them where they were.
But if you wanted, you could record a macro when you filtered and then
copy|pasted those visible rows to the other location.

 

[Luke M]

'Open the VBE (Alt+F11), insert module, paste this in:

'==================
Sub SearchRecords()
Dim FromSheet, ToSheet As String
Dim RecordRow, x, y As Double
'Define sheet names
FromSheet = "Design Review Log"
ToSheet = "Search"

Application.ScreenUpdating = False
RecordRow = 4

'delete previous search
Worksheets(ToSheet).Range("A4:H65000").ClearContents

'setup wildcard searches
For Each cell In Worksheets(ToSheet).Range("A3:H3")
If cell.Value = "" Then cell.Value = "*"
Next cell

'How many rows to search through
LastRow = Worksheets(FromSheet).Cells. _
SpecialCells(xlCellTypeLastCell).Row
For x = 2 To LastRow
For y = 1 To 8
'Check if criteria is not matched
If Not (Worksheets(FromSheet).Cells(x, y) Like _
Worksheets(ToSheet).Cells(3, y)) Then
'if not matched, goto next row
Exit For
ElseIf y = 8 Then
'if all 8 are matched, copy row over
Worksheets(FromSheet).Select
Range(Cells(x, 1), Cells(x, 8)).Copy
Worksheets(ToSheet).Select
Range(Cells(RecordRow, 1), Cells(RecordRow, 8)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
RecordRow = RecordRow + 1
End If
Next y
Next x

For Each cell In Worksheets(ToSheet).Range("A3:H3")
If cell.Value = "*" Then cell.ClearContents
Next cell

Worksheets(ToSheet).Range("A1").Select
Application.ScreenUpdating = True

End Sub
'==========

 

[Luke M]

(after writing macro) Doh!

To expand on Dave's solution, you could even use the Advanced AutoFilter
since you have criteria setup using the same headers. Check out Debra's
article:

http://www.contextures.com/xladvfilter01.html

 

[Brigette]

Luke,

This works perfectly except it's case sensitive. Is there a way to make it
not case sensitive? Thank you so much for your help.

 

[Dave Peterson]

You can make all the code in that module non-case sensitive by adding:

Option Compare Text
at the top of the module (outside any procedure)

Or you can change your comparisons slightly:

If Not (Worksheets(FromSheet).Cells(x, y) Like _
Worksheets(ToSheet).Cells(3, y)) Then

becomes:

If Not (lcase(Worksheets(FromSheet).Cells(x, y)) Like _
lcase(Worksheets(ToSheet).Cells(3, y))) Then

I like to specify the property:

If Not (lcase(Worksheets(FromSheet).Cells(x, y).value) Like _
lcase(Worksheets(ToSheet).Cells(3, y).value)) Then

 

[Brigette]

That works perfectly. Thank you guys sooo much.