Multiple Field Filter using Combo Box Form Control and VBA - Code Error at Multiple Filter Selection

[AsgiE]

Greetings,
I am building a front end filter page where users can select multiple filters using Combo Boxes linked to a database of information in a tab.
I am then using VBA to extract the filtered database to another file.

I have used and IF, Then, Else approach to cycle through the filters to check if there is a filter to apply in the series of filtered cells. The idea being that the user can choose any or all the filters and the extract will work.


I am encountering and "Object Missing" error in the code below highlighted in blue.

Sub Filterandcopyandpasteresults()
'
' Filterandcopyandpasteresults Macro
' Macro which will filter on Discipline and other filters then copy and paste the results in a seperate sheet
'
' Keyboard Shortcut: Ctrl+Shift+F
'

Sheets("Data").Select
If Range(Filters!b1) > 1 And Range(Filters!c1) <> 0 Then
Range("$A$1:$r$2000").AutoFilter Field:=3, Criteria1:=Range("Filters!c2")
Else
If Range(Filters!b9) > 1 And Range(Filters!c9) <> 0 Then
Range("$A$1:$r$2000").AutoFilter Field:=5, Criteria1:=Range("Filters!c9")
Else
If Range(Filters!b13) > 1 And Range(Filters!c13) <> 0 Then
Range("$A$1:$r$2000").AutoFilter Field:=7, Criteria1:=Range("Filters!c13")
Else
If Range(Filters!b17) > 1 And Range(Filters!c17) <> 0 Then
Range("$A$1:$r$2000").AutoFilter Field:=8, Criteria1:=Range("Filters!c17")
Else
If Range(Filters!b21) > 1 And Range(Filters!c21) <> 0 Then
Range("$A$1:$r$2000").AutoFilter Field:=9, Criteria1:=Range("Filters!c21")
Else
If Range(Filters!b25) > 1 And Range(Filters!c25) <> 0 Then
Range("$A$1:$r$2000").AutoFilter Field:=10, Criteria1:=Range("Filters!c25")
End If
End If
End If
End If
End If
End If

Columns("A:R").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Workbooks.Add

ActiveWorkbook.ActiveSheet.Name = "Results"
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Select
Cells.EntireColumn.AutoFit

Workbooks("Prescription Report - MASTER - 2017.12.13").Activate
Sheets("Data").Select
Range("$A$1:$N$2000").AutoFilter Field:=3
Range("$A$1:$N$2000").AutoFilter Field:=5
Range("$A$1:$N$2000").AutoFilter Field:=7
Range("$A$1:$N$2000").AutoFilter Field:=8
Range("$A$1:$N$2000").AutoFilter Field:=9
Range("$A$1:$N$2000").AutoFilter Field:=10

Range("A2").Select
Application.CutCopyMode = False

Range("C2").Select
End Sub



Is there a better method to cycle through the filter selection.
The rest of the code (which still needs some updating) works as expected.

Any help will be greatly appreciated.
Thanks
Regards
Asgi E

 

[Leith Ross]

Hello AsgiE,

The double quotes are missing in the Range statements.

You posted:

If Range(Filters!b1) > 1 And Range(Filters!c1) <> 0 Then

It should be:

If Range("Filters!b1") > 1 And Range("Filters!c1") <> 0 Then

The code can be cleaned up. It will take a little while to do it and post it.

 

[AsgiE]

Thanks Leith. I will try the fix in the meantime. Appreciate the help.
Cheers

 

[Leith Ross]

Hello AsgiE,

Try this revised macro and let me know what happens. I believe it should work okay.

Sub Filterandcopyandpasteresults()
'
' Filterandcopyandpasteresults Macro
' Macro which will filter on Discipline and other filters then copy and paste the results in a seperate sheet
'
' Keyboard Shortcut: Ctrl+Shift+F
' Code updated by Leith Ross 2018.4.1


    Dim fltArray    As Variant
    Dim Index       As Long
    Dim Rng         As Range
    Dim wksData     As Worksheet
    Dim wksFilter   As Worksheet
    
        Set wksData = ThisWorksbook.Worksheets("Data")
        Set wksFilter = ThisWorkbook.Worksheets("Filter")
        
        fltArray = Array("B1", 3, "B9", 5, "B13", 7, "B17", 8, "B21", 9, "B25", 10)
        
        With wksFilter
            For addx = 0 To UBound(fltArray) Step 2
                Set Rng = .Range(addx)
                Index = fltArray(addx + 1)
                If Rng > 1 And Rng.Offset(0, 1) <> 0 Then
                    wksData.Range("$A$1:$R$2000").AutoFilter Field:=Index, Criteria:=Rng.Offset(0, 1)
                    Exit For
                End If
            Next addx
        End With
        
        On Error Resume Next
            wksData.Range("$A$1:$R$2000").SpecialCells(xlCellTypeVisible).Copy
            If Err <> 0 Then Exit Sub
        On Error GoTo 0
        
        Set Wkb = Workbooks.Add
        
        With Wkb.ActiveSheet
            .Name = "Results"
            .Range("A4").PasteSpecial Paste:=xlPasteValues
            .Range("A4").PasteSpecial Paste:=xlPasteFormats
            .UsedRange.Select
        End With
        
        Selection.EntireColumn.AutoFit
        Application.CutCopyMode = False
        
        wksData.AutoFilterMode = False
        
        With wksData.Range("$A$1:$N$2000")
            For Index = 0 To UBound(fltArray) Step 2
                .AutoFilter Field:=fltArray(Index + 1)
            Next Index
        End With
        
        ThisWorkbook.Activate
        wksData.Range("C2").Select


End Sub

 

[AsgiE]

Thanks Leith. I can read and understand most of it and see that you have significantly simplified the code by creating an Array out of the filters. Currently beyond me!
However when I try to step through this I get a compile error Names Argument Not found for "Criteria:=Rng.Offset(0,1).

Can you help?

 

[Leith Ross]

Hello AsgiE,

Sorry about that, that was my error. It should be...

        With wksFilter
            For addx = 0 To UBound(fltArray) Step 2
                Set Rng = .Range(fltArray(addx))
                Index = fltArray(addx + 1)
                If Rng > 1 And Rng.Offset(0, 1) <> 0 Then
                    wksData.Range("$A$1:$R$2000").AutoFilter Field:=Index, Criteria:=Rng.Offset(0, 1)
                    Exit For
                End If
            Next addx
        End With

 

[AsgiE]

Ah! Thanks. Just tried it out and I still get the "Names Argument Not found for "Criteria:=" (highlighted in orange below)

With wksFilter
For addx = 0 To UBound(fltArray) Step 2
​

Set Rng = .Range(fltArray(addx))​

Index = fltArray(addx + 1)
If Rng > 1 And Rng.Offset(0, 1) <> 0 Then
wksData.Range("$A$1:$R$2000").AutoFilter Field:=Index, ​

Criteria:=​

Rng.Offset(0, 1)
Exit For
End If
Next addx
End With​

Appreciate the feedback and help.
In the meantime I have also managed to get my script working as well and a few more selection options as well.
Cheers

 

[Leith Ross]

Hello AsgiE,

The Range method of AutoFilter is a little different than the Worksheet method. This correction should work...

        With wksFilter
            For addx = 0 To UBound(fltArray) Step 2
                Set Rng = .Range(fltArray(addx))
                Index = fltArray(addx + 1)
                If Rng > 1 And Rng.Offset(0, 1) <> 0 Then
                    wksData.Range("$A$1:$R$2000").AutoFilter Field:=Index, Criteria1:=Rng.Offset(0, 1)
                    Exit For
                End If
            Next addx
        End With