VBA/Macro to select additional criteria on already filtered results

[HakanNedjat]

Hi all,

New to the forum, found it extremely helpful with my situations so far but I cannot seem to find an answer for my most recent problem.

I am trying to create a form for a client that build up a list of parts needed based on what optional extras they choose (using option buttons).

The list starts with all of the parts if every option was chosen but then is filtered down to the basic starting point, from here I want to then select certain criteria as each option is selected, keeping the existing choices unfiltered and adding to the list.

Here's what code I have so far:

Private Sub OptionButton5_Click()
Rows("13:40").Select
Selection.EntireRow.Hidden = False
Sheets("Build Sheet").Select
ActiveSheet.Range("$B$3:$I$101").AutoFilter Field:=1, Criteria1:="=RW480"
ActiveSheet.Range("$B$3:$I$101").AutoFilter Field:=2, Criteria1:="=Hull"
Sheets("Quote").Select
ActiveSheet.Range("C14").Select
ActiveCell.FormulaR1C1 = "='Spec up boat'!R[-6]C[-1]"
Sheets("Spec up boat").Select
ActiveSheet.Range("A1").Select
End Sub

Private Sub OptionButton11_Click()
Sheets("Build Sheet").Select
ActiveSheet.Range("$B$3:$I$103").AutoFilter Field:=2, Criteria1:= _
"=6mm Bottom"
Sheets("Spec up boat").Select
Range("A1").Select
End Sub

The problem is when I select "optionbutton11" it gets rid of the criteria from "optionbutton5".
Is there a way of writing the code so it does not get rid of any criteria already chosen? Just adds to it?

Thanks for your help.
Hakan

 

[AlphaFrog]

What version of Excel do you have?

 

[HakanNedjat]

I'm using 2010.

I will also need to know if it's possible to reverse the function.
So will I be able to remove certain criteria if, say, another optionbutton is checked. (eg. they choose "no" instead of "yes")

 

[AlphaFrog]

You will need to further mod this for all your options.

Have each option button call another sub procedure that does the filtering. That procedure goes through all the selected options and builds a criteria-array for each column. Then apply the criteria-arrays with Autofilter.

This should work for Excel 2007 and later.


This is for Option5 and Option11 (not tested). I'm not sure what your doing with two of the lines commented with '???

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] OptionButton5_Click()
    Filter_Options
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
    
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] OptionButton11_Click()
    Filter_Options
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
    
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Filter_Options()
    
    [color=darkblue]Dim[/color] arrCriteraB(1 [color=darkblue]To[/color] 11) [color=darkblue]As[/color] [color=darkblue]String[/color], arrCriteraC(1 [color=darkblue]To[/color] 11) [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] b [color=darkblue]As[/color] [color=darkblue]Long[/color], c [color=darkblue]As[/color] Long
    
    [color=darkblue]If[/color] OptionButton5.Value [color=darkblue]Then[/color]
        c = c + 1
        arrCriteraC(c) = "=6mm Bottom"
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    [color=darkblue]If[/color] OptionButton11.Value [color=darkblue]Then[/color]
        b = b + 1
        arrCriteraB(b) = "=RW480"
        c = c + 1
        arrCriteraC(c) = "=Hull"
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    
    Rows("13:40").EntireRow.Hidden = [color=darkblue]False[/color]  [color=green]'???[/color]
    
    [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] arrCriteraB(1 [color=darkblue]To[/color] b)
    [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] arrCriteraC(1 [color=darkblue]To[/color] c)
    
    [color=darkblue]With[/color] Sheets("Build Sheet").Range("B3:I101")
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:=arrCriteraB, Operator:=xlFilterValues
        .AutoFilter Field:=2, Criteria1:=arrCriteraC, Operator:=xlFilterValues
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    Sheets("Quote").Range("C14").FormulaR1C1 = "='Spec up boat'!R[-6]C[-1]" [color=green]'???[/color]
                                                
    Application.Goto Sheets("Spec up boat").Range("A1")
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

You may want to consider using one Checkbox instead of two Yes\No option buttons.

 

[HakanNedjat]

Thanks AlphaFrog, I'll see if I can digest this.
Would checkboxes work when unchecked too? I'd want to remove items from a it's when the option is not checked...

 

[AlphaFrog]

Thanks AlphaFrog, I'll see if I can digest this.
Would checkboxes work when unchecked too? I'd want to remove items from a it's when the option is not checked...

Yes

 

[HakanNedjat]

My VBA knowledge is minimal so I have changed the workings around to make it easier. I'm now incorporating checkboxes that build a list of criteria. From this I will use a button to run an autofilter once the checkboxes have been ticked.

I've created a macro to get the code but it does not seem to work when I press the button:

Private Sub CommandButton1_Click()    Sheets("Build Sheet").Select
    Sheets("Build Database").Range("B3:J44").AdvancedFilter Action:=xlFilterCopy _
        , CriteriaRange:=Range("B2:J6"), CopyToRange:=Range([COLOR=#ff0000]"'Build Sheet'!Extract" _[/COLOR]
[COLOR=#ff0000]        [/COLOR]), Unique:=False
End Sub

I'm not sure why it came up with the section in red, I want it to return the results on the "build sheet" starting from cell "B10". For reference the button is on another sheet, separate from the "build sheet" and "build database"

Any help on this would be greatly appreciated.

Hakan

 

[HakanNedjat]

Any help on this would be greatly appreciated

 

[HakanNedjat]

No worries, I played around with the code and worked it out.
Here's the code if anyone has a similar problem (obviously changing sheet names etc.):

Sheets("Build Sheet").Select
Sheets("Build Database").Range("B3:J44").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Build Sheet").Range("B2:J8"), CopyToRange:=Sheets("Build Sheet").Range("B12:J12"), _
Unique:=False