How to use "If" in array for filtering multiple columns with multiple criteria vba

Question

I was trying to find if we can use "If" in array to filter multiple columns in a single code. For example, I've data in 2 columns & to get result, I've to use filter twice.

First Step to filter with Apple in column 7 & today-3 & before in column 8

ActiveSheet.Range("A1:W100000").AutoFilter Field:=7, Operator:=xlFilterValues, Criteria1:="Apple"
ActiveSheet.Range("A1:W100000").AutoFilter Field:=8, Operator:=xlFilterValues, Criteria1:="=>"& Date-3)

Second Step to filter with Banana in column 7 & today-7 & before in column 8

ActiveSheet.Range("A1:W100000").AutoFilter Field:=7, Operator:=xlFilterValues, Criteria1:="Banana"
ActiveSheet.Range("A1:W100000").AutoFilter Field:=8, Operator:=xlFilterValues, Criteria1:="=>"& Date-7)

Is it possible to get filter result in one go by using "If" as an array like "(If field 7 = Apple, fields 8 = "=>"& Date-3) and (If field 7 = Banana, fields 8 = "=>"& Date-7)"?

Please help

Sub Get_Value()
    Sheets.ADD After:=Sheets(Sheets.count)
    ActiveSheet.Name = "Sheet2"
    Worksheets("Sheet1").Select
    Worksheets("Sheet1").AutoFilterMode = False
    Application.DisplayAlerts = False
    ActiveSheet.Range("A1:AZ100000").AutoFilter Field:=7, Criteria1:="Apple"
    ActiveSheet.Range("A1:AZ100000").AutoFilter Field:=8, Criteria1:="<=" & Date - 3
If (ActiveSheet.Range("G2", Range("G" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).count - 1) = 0 Then
    MsgBox "There are no values found"
    Else
    Worksheets("Sheet1").Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Worksheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
End If
    Worksheets("Sheet1").Select
    Worksheets("Sheet1").AutoFilterMode = False
    Application.DisplayAlerts = False
    ActiveSheet.Range("A1:AZ100000").AutoFilter Field:=7, Criteria1:="Banana"
    ActiveSheet.Range("A1:AZ100000").AutoFilter Field:=8, Criteria1:="<=" & Date - 7
If (ActiveSheet.Range("G2", Range("G" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).count - 1) = 0 Then
    MsgBox "There are no values found"
    Else
    ActiveSheet.Range("G2", Range("G" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
    Worksheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
End If

End Sub

If you need `(7=A AND 8=3)OR(7=B AND 8=7)` then there are a few possibilities depending on what you are planning to do with it. What are you planning to do with it? Look at it, print it, copy it or its values to another worksheet, etc. Please do clarify. Also, if you don't have 99,999 rows of data, you might consider calculating the last row. — VBasic2008, Mar 22 '21 at 20:00
I would like to copy filtered data to another sheet. If I do with above code then I’ll have to copy first result i.e. 7=A and 8=3 (sometimes there might not be the result) and then apply filter again i.e. 7=B and 8=7 and copy second result to the next available row of another sheet. To avoid this duplication or repeatation, i’m looking for single filter with above criteria and copy to another sheet. Sheet will not have 99,999 rows of data. — Satish, Mar 22 '21 at 20:15
Are values ok, or do you need the formatting and formulas, too? Could you post the complete code you have so far? — VBasic2008, Mar 22 '21 at 20:26
@VBasic2008 - I've added complete code. It would be great if you help with values, formatting and formulas too. Thanks in advance! — Satish, Mar 22 '21 at 21:05
Aside - consider reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/q/10714251/1422451). — Parfait, Mar 22 '21 at 21:21
Did you mean to run both sets of conditions so need `OR`: "(If field 7 = Apple, fields 8 = "=>"& Date-3) **or** (If field 7 = Banana, fields 8 = "=>"& Date-7)"? — Parfait, Mar 22 '21 at 21:24

Parfait · Accepted Answer · 2021-03-23T16:48:12.573

Consider creating a new column for your logical needs and apply filter on that condition. Below avoids Select and ActiveSheet and uses complete period qualifier of all Excel sheet and range objects. Also, below shows only the specific filter solution and not the other new worksheet or copy/paste steps which should be integrated accordingly.

Dim i As Long

With ThisWorkbook.Worksheets("Sheet1")
    .AutoFilterMode = False
     Application.DisplayAlerts = False

    ' ADD CONDITIONAL COLUMN (G AS 7th COLUMN, H AS 8TH COLUMN)
    For i = 2 To 100000
       .Range("BA" & i).Formula = "=IF(OR(AND(G" & i & " = ""Apple"",  H" & i & " <= DATEVALUE(""" & Date - 3 & """))," _
                                      & " AND(G" & i & " = ""Banana"", H" & i & " <= DATEVALUE(""" & Date - 7 & """))), TRUE, FALSE)"
    Next i
    
    ' ALTERNATIVE PER @VBasic2008
    ' .Range("BA2:BA" & 20).Formula = "=IF(OR(AND(G2 = ""Apple"",  H2 <= TODAY() - 3)," _
    '                                     & " AND(G2 = ""Banana"", H2 <= TODAY() - 7)), TRUE, FALSE)"

    ' APPLY FILTER (BA BEING 53RD COLUMN)
    .Range("A1:BA1").AutoFilter Field:=53, Criteria1:="TRUE"
End With

The loop is pretty much unacceptable, when you could improve with e.g. `.Range("BA2:BA100000").Formula = "=IF(OR(AND(G2=""Apple"",H2<=TODAY()-3),AND(G2=""Banana"",H2<=TODAY()-7)),TRUE,FALSE)"`. Don't you think so? — VBasic2008, Mar 23 '21 at 04:26

VBasic2008 · Answer 2 · 2021-03-23T04:09:59.703

Copy Multi-Filtered (`Advanced Filter`)

Option Explicit

Sub copyMultiFiltered()
    
    Const sName As String = "Sheet1"
    Const dName As String = "Sheet2"
    
    Dim Fields As Variant: Fields = Array(7, 8)
    Dim CritPairs As Variant
    CritPairs = Array("Apple", 3, "Banana", 7)
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim fInit As Long: fInit = LBound(Fields) - 1
    Dim crInit As Long: crInit = LBound(CritPairs) - 1
    Dim rCount As Long: rCount = (UBound(CritPairs) - crInit) / 2 + 1
    Dim Data As Variant: ReDim Data(1 To rCount, 1 To 2)
    
    Dim srg As Range: Set srg = wb.Worksheets(sName).Range("A1").CurrentRegion
    
    Dim j As Long
    For j = 1 To 2
        Data(1, j) = srg.Cells(1, Fields(fInit + j)).Value
    Next j
    For j = 2 To rCount
        Data(j, 1) = CritPairs((j - 2) * 2 + crInit + 1)
        Data(j, 2) = "<=" & CLng(Date - CritPairs((j - 2) * 2 + crInit + 2))
    Next j
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    On Error GoTo 0
    If dws Is Nothing Then
        Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        dws.Name = dName
    Else
        dws.Cells.Clear
    End If
    
    Dim crg As Range
    Dim drg As Range
    With dws.Range("A1")
        Set crg = .Resize(rCount, 2)
        crg.Value = Data
        Set drg = .Resize(, srg.Columns.Count).Offset(rCount + 1)
    End With
    
    srg.AdvancedFilter xlFilterCopy, crg, drg
    
    dws.Rows(1).Resize(rCount + 1).Delete
    srg.Rows(1).Copy
    With dws.Cells(1)
        .PasteSpecial Paste:=xlPasteColumnWidths
        Application.CutCopyMode = False
        .Worksheet.Activate
        .Select
    End With
    
    Application.ScreenUpdating = True

End Sub

How to use "If" in array for filtering multiple columns with multiple criteria vba

2 Answers2

Copy Multi-Filtered (Advanced Filter)

Copy Multi-Filtered (`Advanced Filter`)