Combining 2 Searches - Then Copy Entire Row

[Airbisk]

Hi,

Presently I have 1 button that has the macro below assigned which searches Site Print Column A and matching the value with Cell F9 in Criteria and then pulling the entire row into Search Results.

Sub accountmoving()
Dim c As Range, d As Range

If Range("F9") = "" Then

MsgBox "Please Select an Account"

Else

Worksheets("Search Results").Activate

For Each c In Worksheets("Site Print").Range("A1:A8000")
For Each d In Worksheets("Criteria").Range("F9")
If c = d Then
c.EntireRow.Copy Worksheets("Search Results").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

End If

End Sub

I have another button that does somthing very similar but searches a different column, again pulling the matching cell's row into Search Results. Code Below...

Sub itemmoving()
Dim c As Range, d As Range

If Range("F11") = "" Then

MsgBox "Please Select an Item Description"

Else

Worksheets("Search Results").Activate

For Each c In Worksheets("Site Print").Range("L1:L8000")
For Each d In Worksheets("Criteria").Range("F11")
If c = d Then
c.EntireRow.Copy Worksheets("Search Results").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

End If

End Sub

What I am after doing is creating another button that basically merges the two searches so if both columns match then it copys the entire row. I did try and do it myself by running the first routine into a new sheet then call the next routine from that sheet, copying the results into Serach Results. Problem with this is if one search field was left blank then this would affect the results.

Any pointers/help would be greatly appreciated.

Thanks

 

[SkipVought]

Problem with this is if one search field was left blank then this would affect the results.

Then test BOTH before executing any search.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[Airbisk]

Thanks Skip, Okay i have been away, messed around and got something working but it still requires all fields to be filled in. I have created 4 new worksheets for each search criteria, Account, Code, Range, Controller

Procedure allselected() is assigned to a button.

Procedure accountsearch() copies its results from Site Print into Account, then calls codesearch()

Procedure codesearch() copies its results from Account into Code, then calls rangesearch()

Procedure rangesearch() copies its results from Code into Range, then calls controllersearch()

Procedure controllersearch() copies its results from Range into Search Results.

Please see full code below.

The problem I have is that some of the search fields may be left blank, is there a way of creating the sheets as each procedure is called rather than me creating them beforehand? That way it wont fall over when it comes to the first hurdle or can a 4 way search on a row be possible?

Sub allselected()

If Worksheets("Criteria").Range("F9") = "" Then

Call codesearch

Else

Call accountsearch

End If

End Sub


Sub accountsearch()
Dim c As Range, d As Range

Worksheets("Account").Activate
Application.ScreenUpdating = False
Cells.Select
Selection.ClearContents

For Each c In Worksheets("Site Print").Range("A1:A8000")
For Each d In Worksheets("Criteria").Range("F9")
If c = d Then
c.EntireRow.Copy Worksheets("Account").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

Call codesearch

End Sub


Sub codesearch()
Dim c As Range, d As Range

If Worksheets("Criteria").Range("F11") = "" Then

Call rangesearch

Else

Worksheets("Code").Activate
Application.ScreenUpdating = False
Cells.Select
Selection.ClearContents

For Each c In Worksheets("Account").Range("L1:L8000")
For Each d In Worksheets("Criteria").Range("F11")
If c = d Then
c.EntireRow.Copy Worksheets("Code").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

Call rangesearch

End If

End Sub



Sub rangesearch()
Dim c As Range, dFrom As Date, dThru As Date

If Worksheets("Criteria").Range("F15") = "" Then

Call controllersearch

Else

dFrom = Worksheets("Criteria").Range("F15").Value
dThru = Worksheets("Criteria").Range("F17").Value

Worksheets("Range").Activate
Application.ScreenUpdating = False
Cells.Select
Selection.ClearContents

For Each c In Worksheets("Code").Range("J1:J8000")
For Each d In Worksheets("Criteria").Range("F15")
If c.Value >= dFrom And c.Value <= dThru Then
c.EntireRow.Copy Worksheets("Range").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

Call controllersearch

End If

End Sub


Sub controllersearch()
Dim c As Range, d As Range

Worksheets("Search Results").Activate
Application.ScreenUpdating = False
Cells.Select
Selection.ClearContents

Sheets("Site Print").Select
Rows("1:1").Select
Selection.Copy
Sheets("Search Results").Select
Rows("1:1").Select
ActiveSheet.Paste


For Each c In Worksheets("Range").Range("C1:C8000")
For Each d In Worksheets("Criteria").Range("F19")
If c = d Then
c.EntireRow.Copy Worksheets("Search Results").Range("A65536").End(xlUp).Offset(1, 0)
Exit For
End If
Next
Next

Cells.Select
Cells.EntireColumn.AutoFit
Range("D3").Select
Columns("E:E").ColumnWidth = 48.71
Columns("P").ColumnWidth = 38.86
Columns("A:A").ColumnWidth = 8.29
Rows("1:1").RowHeight = 15.75

Range("A1").Select

End Sub

 

[SkipVought]

You perform all your searches, then evaluate your search results before you do anything else. Does not matter how many searches you have. If you need all the data, this will tell you.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}