searching more than one criteria with VBA

[VbaHell]

Hello all

A fellow member very kindly provided me with this code to complete a search from a worksheet named "Result" in cell "A6" and search the data from the worksheet called "Data" from column 15

I want to try and expand on this and be able to search more than one column at the same time

"A6" searches column 15
"B6" searches column 3
"C6" searches column 12

If any of the search cells are blank then ignore

"A6" = "" then don't search with this cell value so you would end up with searching on "B6" and "C6"

If "B6 and C6 was blank then you would only search on "A6"

I hope this makes sense and is possible

[LEFT][COLOR=#333333][FONT=monospace]Sub Filter_Me_Please()
'Modified  10/21/2018  1:10:18 PM  EDT
Application.ScreenUpdating = False
Dim lastrow As Long
Dim c As Long
Dim s As Variant
Sheets("Data").Activate
c = 15 ' Column Number Modify this to your need
s = Sheets("Result").Range("A6").Value 'Search Value Modify to your need
lastrow = Cells(Rows.Count, c).End(xlUp).Row
With ActiveSheet.Cells(1, c).Resize(lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
    .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Result").Cells(10, "A")
        
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub[/FONT][/COLOR][/LEFT]

 

[Fluff]

If both A6 & B6 have a value do you want to copy those rows that have both values, or those that have either?

 

[VbaHell]

You have brought up a very good point Fluff that i did not consider

I was thinking on a filter type search so "A6" would be the first search value, Then "B6" and finally "C6"

If "A6" is blank then the first filter would be "B6", if this is blank then "C6"

Then copy over all the rows that match the search criteria

Hope this makes sense

 

[Fluff]

Will you ever have a value in two or more of those cells, or just one cell with a value?

 

[VbaHell]

you could have a value in all three

Filter on "A6" then stop there if no value in B6 or C6
copy all rows that match the criteria​

Filter on "A6" & "B6" stop there if "C6" is blank
Copy all rows that match critera

Or any combination between the three cells

basically a filter search that reduces the rows down as you filter on each value

 

[Fluff]

So if A6 & B6 have values & C6 is blank, you want to copy all rows that contain BOTH A6 & B6 values

 

[dmt32]

I was thinking on a filter type search so "A6" would be the first search value, Then "B6" and finally "C6"

If "A6" is blank then the first filter would be "B6", if this is blank then "C6"

Then copy over all the rows that match the search criteria

Not tested but see if this update to your code helps

ub Filter_Me()
    Dim lastrow As Long, CopyRow As Long, c As Long, counter As Long
    Dim i As Integer
    Dim s As Variant
    Dim msg As String
    Dim cell As Range
    Dim wsResult As Worksheet
    
'"A6" searches column 15
'"B6" searches column 3
'"C6" searches column 12


    Set wsResult = ThisWorkbook.Sheets("Result")
    
    Application.ScreenUpdating = False
    
    For Each cell In wsResult.Range("A6,B6,C6").Cells
        i = i + 1
        s = cell.Value
        c = Choose(i, 15, 3, 12)
        
        If Len(s) > 0 Then
            With ThisWorkbook.Sheets("Data")
                lastrow = .Cells(.Rows.Count, c).End(xlUp).Row
                With .Cells(1, c).Resize(lastrow)
                    .AutoFilter 1, s
                    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
                    If counter > 1 Then
                        CopyRow = wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1
                        If CopyRow < 10 Then CopyRow = 10
                        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy wsResult.Cells(CopyRow, "A")
                    Else
                        msg = msg & s & Chr(10)
                    End If
                    .AutoFilter
                End With
            End With
        End If
    Next cell
    Application.ScreenUpdating = True
    If Len(msg) > 0 Then MsgBox msg & Chr(10) & "No values found", 48, "Not Found"
End Sub

adjust as required

Dave

 

[VbaHell]

Hi Fluff

It's very close to what I am looking for

At the moment it will find all the records that match all values from A,B,C

I need it to filter or narrow down the result


if A = DOG show all rows that match DOG
if A = DOG and B = swan then search all the row that are filter by A = DOG and then only show DOG and SWAN
if A = DOG and B = Swan then only search all the rows the are filter by A & B

If any of the cells A,B,C are blank then filter on the one's that have a value

It's like using the Data sort function in excel where you can add another level

 

[Fluff]

How about

Sub CopyFltr()
   Dim Rws As Worksheet, Dws As Worksheet
   Dim Ary As Variant
   
   Set Rws = Sheets("Result")
   Set Dws = Sheets("Data")
   Ary = Array(Rws.Range("A6"), 15, Rws.Range("B6"), 3, Rws.Range("C6"), 12)
   If Dws.AutoFilterMode Then Dws.AutoFilterMode = False
   With Dws.Range("A1:[COLOR=#ff0000]O[/COLOR]1")
      If Ary(0) <> "" Then .AutoFilter Ary(1), Ary(0)
      If Ary(2) <> "" Then .AutoFilter Ary(3), Ary(2)
      If Ary(4) <> "" Then .AutoFilter Ary(5), Ary(4)
      .Parent.AutoFilter.Range.Offset(1).Copy Rws.Range("A" & Rows.Count).End(xlUp).Offset(1)
   End With
   Dws.AutoFilterMode = False
End Sub

Change the highlighted O to reflect the last column in your sheet

 

[VbaHell]

that's it, fantastic, thanks very much