Combo Box Filtering Code

C

CEG

Board Regular
Joined
Jan 3, 2010
Messages
74
I was wondering if anyone out there had any suggestions on how to make this code more simple and not so long and repetitive. What I have is 2 combo boxes, one with a detailer's name and the other with a month. Depending on what is picked, it filters another worksheet and fills in values from that worksheet. I guess what I am looking for is to not repeat this code 4 times.
Code: 
With Worksheets("filtered")
                .Range("B5") = rng.Cells(1, "FQ")
                .Range("B6") = rng.Cells(1, "FV")
                .Range("I5") = rng.Cells(1, "GA")
                .Range("I11") = rng.Cells(1, "FZ")
                .Range("I12") = rng.Cells(1, "FY")
                .Range("I13") = rng.Cells(1, "FX")
                .Range("I14") = rng.Cells(1, "FW")
                .Range("B11") = rng.Cells(1, "FP")
                .Range("B12") = rng.Cells(1, "FO")
                .Range("B13") = rng.Cells(1, "FN")
                .Range("B14") = rng.Cells(1, "FM")
                For x = 1 To 46
                    .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
                Next x
                For y = 1 To 20
                    .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
                Next y
            End With
Any help would be appreciated.

Code: 
Private Sub cmdFilterDetailer_Click()
    Dim rng As Range
    Dim x As Long
    Dim y As Long
    Set rng = Worksheets("part number").Range("Subtotals")
    Worksheets("part number").AutoFilterMode = False
    With Worksheets("part number").Columns("G:L")
        .AutoFilter
        If cboDetailFilter = "All" And cboDateFilter = "All" Then
            On Error Resume Next
            With Worksheets("filtered")
                .Range("B5") = rng.Cells(1, "FQ")
                .Range("B6") = rng.Cells(1, "FV")
                .Range("I5") = rng.Cells(1, "GA")
                .Range("I11") = rng.Cells(1, "FZ")
                .Range("I12") = rng.Cells(1, "FY")
                .Range("I13") = rng.Cells(1, "FX")
                .Range("I14") = rng.Cells(1, "FW")
                .Range("B11") = rng.Cells(1, "FP")
                .Range("B12") = rng.Cells(1, "FO")
                .Range("B13") = rng.Cells(1, "FN")
                .Range("B14") = rng.Cells(1, "FM")
                For x = 1 To 46
                    .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
                Next x
                For y = 1 To 20
                    .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
                Next y

            End With
        ElseIf cboDetailFilter.Value = "All" And cboDateFilter <> "All" Then
            .AutoFilter Field:=6, Criteria1:=cboDateFilter.Value
            On Error Resume Next
            With Worksheets("filtered")
                .Range("B5") = rng.Cells(1, "FQ")
                .Range("B6") = rng.Cells(1, "FV")
                .Range("I5") = rng.Cells(1, "GA")
                .Range("I11") = rng.Cells(1, "FZ")
                .Range("I12") = rng.Cells(1, "FY")
                .Range("I13") = rng.Cells(1, "FX")
                .Range("I14") = rng.Cells(1, "FW")
                .Range("B11") = rng.Cells(1, "FP")
                .Range("B12") = rng.Cells(1, "FO")
                .Range("B13") = rng.Cells(1, "FN")
                .Range("B14") = rng.Cells(1, "FM")
                For x = 1 To 46
                    .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
                Next x
                For y = 1 To 20
                    .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
                Next y
            End With
        ElseIf cboDateFilter = "All" And cboDetailFilter.Value <> "All" Then
            .AutoFilter Field:=1, Criteria1:=cboDetailFilter.Value
            On Error Resume Next
            With Worksheets("filtered")
                .Range("B5") = rng.Cells(1, "FQ")
                .Range("B6") = rng.Cells(1, "FV")
                .Range("I5") = rng.Cells(1, "GA")
                .Range("I11") = rng.Cells(1, "FZ")
                .Range("I12") = rng.Cells(1, "FY")
                .Range("I13") = rng.Cells(1, "FX")
                .Range("I14") = rng.Cells(1, "FW")
                .Range("B11") = rng.Cells(1, "FP")
                .Range("B12") = rng.Cells(1, "FO")
                .Range("B13") = rng.Cells(1, "FN")
                .Range("B14") = rng.Cells(1, "FM")
                For x = 1 To 46
                    .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
                Next x
                For y = 1 To 20
                    .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
                Next y
            End With
        Else
            .AutoFilter Field:=6, Criteria1:=cboDateFilter.Value
            .AutoFilter Field:=1, Criteria1:=cboDetailFilter.Value
            On Error Resume Next
            With Worksheets("filtered")
                .Range("B5") = rng.Cells(1, "FQ")
                .Range("B6") = rng.Cells(1, "FV")
                .Range("I5") = rng.Cells(1, "GA")
                .Range("I11") = rng.Cells(1, "FZ")
                .Range("I12") = rng.Cells(1, "FY")
                .Range("I13") = rng.Cells(1, "FX")
                .Range("I14") = rng.Cells(1, "FW")
                .Range("B11") = rng.Cells(1, "FP")
                .Range("B12") = rng.Cells(1, "FO")
                .Range("B13") = rng.Cells(1, "FN")
                .Range("B14") = rng.Cells(1, "FM")
                For x = 1 To 46
                    .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
                Next x
                For y = 1 To 20
                    .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
                Next y
            End With
        End If
        .AutoFilter
    End With
    ActiveSheet.Rows("3:3").Hidden = True
End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
hi. you can break up your code into a repeated part (i called it 'MyFilterCode') and a main routine. this removes the repeating you are have trouble with.

Code: 
Private Sub cmdFilterDetailer_Click()
    Dim rng As Range
    Dim x As Long
    Dim y As Long
    Set rng = Worksheets("part number").Range("Subtotals")
    Worksheets("part number").AutoFilterMode = False
    With Worksheets("part number").Columns("G:L")
        .AutoFilter
        If cboDetailFilter = "All" And cboDateFilter = "All" Then
            On Error Resume Next
            MyFilterCode

        ElseIf cboDetailFilter.Value = "All" And cboDateFilter <> "All" Then
            .AutoFilter Field:=6, Criteria1:=cboDateFilter.Value
            On Error Resume Next
            MyFilterCode

        ElseIf cboDateFilter = "All" And cboDetailFilter.Value <> "All" Then
            .AutoFilter Field:=1, Criteria1:=cboDetailFilter.Value
            On Error Resume Next
            MyFilterCode

        Else
            .AutoFilter Field:=6, Criteria1:=cboDateFilter.Value
            .AutoFilter Field:=1, Criteria1:=cboDetailFilter.Value
            On Error Resume Next
            MyFilterCode
        End If
        .AutoFilter
    End With
    ActiveSheet.Rows("3:3").Hidden = True
End Sub

Sub MyFilterCode
            With Worksheets("filtered")
                .Range("B5") = rng.Cells(1, "FQ")
                .Range("B6") = rng.Cells(1, "FV")
                .Range("I5") = rng.Cells(1, "GA")
                .Range("I11") = rng.Cells(1, "FZ")
                .Range("I12") = rng.Cells(1, "FY")
                .Range("I13") = rng.Cells(1, "FX")
                .Range("I14") = rng.Cells(1, "FW")
                .Range("B11") = rng.Cells(1, "FP")
                .Range("B12") = rng.Cells(1, "FO")
                .Range("B13") = rng.Cells(1, "FN")
                .Range("B14") = rng.Cells(1, "FM")
                For x = 1 To 46
                    .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
                Next x
                For y = 1 To 20
                    .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
                Next y
            End With
End Sub
 
Upvote 0
Not Tested

Code: 
Private Sub cmdFilterDetailer_Click()
    Dim rng As Range
    Dim x As Long
    Dim y As Long
    Set rng = Worksheets("part number").Range("Subtotals")
    Worksheets("part number").AutoFilterMode = False
    With Worksheets("part number").Columns("G:L")
        
        If cboDetailFilter = "All" And cboDateFilter = "All" Then
            .AutoFilter
        ElseIf cboDetailFilter.Value = "All" And cboDateFilter <> "All" Then
            .AutoFilter Field:=6, Criteria1:=cboDateFilter.Value
        ElseIf cboDateFilter = "All" And cboDetailFilter.Value <> "All" Then
            .AutoFilter Field:=1, Criteria1:=cboDetailFilter.Value
        Else
            .AutoFilter Field:=6, Criteria1:=cboDateFilter.Value
            .AutoFilter Field:=1, Criteria1:=cboDetailFilter.Value
        End If
        
        On Error Resume Next
        With Worksheets("filtered")
            .Range("B5") = rng.Cells(1, "FQ")
            .Range("B6") = rng.Cells(1, "FV")
            .Range("I5") = rng.Cells(1, "GA")
            .Range("I11") = rng.Cells(1, "FZ")
            .Range("I12") = rng.Cells(1, "FY")
            .Range("I13") = rng.Cells(1, "FX")
            .Range("I14") = rng.Cells(1, "FW")
            .Range("B11") = rng.Cells(1, "FP")
            .Range("B12") = rng.Cells(1, "FO")
            .Range("B13") = rng.Cells(1, "FN")
            .Range("B14") = rng.Cells(1, "FM")
            For x = 1 To 46
                .Range("B40").Offset(x - 1) = rng.Cells(1, "BK").Offset(, x - 1)
            Next x
            For y = 1 To 20
                .Range("J40").Offset(y - 1) = rng.Cells(1, "DE").Offset(, y - 1)
            Next y
        End With

        .AutoFilter
    End With
    ActiveSheet.Rows("3:3").Hidden = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
sumif function with delayed application
Replies
5
Views
323
jbrown021286
J
P
  • Question Question
Populate Combo Box on Sheet with range of values
Replies
0
Views
405
psycoperl
P
J
  • Solved
VBA Code To Loop Through One Worksheet and Paste Certain Values Into Another
Replies
5
Views
174
Peter_SSs
Peter_SSs
B
  • Question Question
dynamic formula help - supply multiple variables and process row by row
Replies
0
Views
577
BrettJH
B
A
  • Solved
Sum hours by date range by employee ID
Replies
3
Views
298
alessiaexcels
A

Forum statistics

Threads
1,224,885
Messages
6,181,579
Members
453,055
Latest member
cope7895

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top