31 Checkboxes with autofilter query

[BellaEC]

Hi,

I've tried with this the best I could but I'm failing, I'm hoping some vba whizz can help me out, Its not letting me attach a workbook here so I hope pictures are ok to describe but please come back to me if its not making sense.

I have a workbook called SWMS with two tabs, Template & RiskRegister. On Template I have 31 checkboxes all with a caption of 1-31. On the tab RiskRegister I have a table called tblRisks4 which in column A is numbered 1-31 by different risks. Now each number could be in the row numerous times as it's associated with a sub header in column B.

I'm trying to tick numerous checkboxes on tab Tempate which would filter my RiskRegister by each checkbox ticked & hitting the cmdSWMS button would copy that table range to allow me to input that into another report.

I think I need to put the call filters for each checkbox into the cmdbutton but I dont know how to do it, any help would be greatly appreciated.

Please see pictures below;

[/URL][/IMG]

[/URL][/IMG]

In Module1:

Option Explicit
Sub Filter_Me()
    Dim LR As Long
    Dim objcBox As Object
    Dim cBox As Variant

    ReDim cBox(0)
    Application.ScreenUpdating = False
    With Sheets("RiskRegister")
        .AutoFilterMode = False
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row

        For Each objcBox In .OLEObjects
            If TypeName(objcBox.Object) = "CheckBox" Then
                If objcBox.Object.Value = True Then
                    cBox(UBound(cBox)) = objcBox.Object.Caption
                    ReDim Preserve cBox(UBound(cBox) + 1)
                End If
            End If
        Next
'        If IsError(Application.Match("*", (cBox), 0)) Then
'            MsgBox "Nothing Selected"
'            Exit Sub
'        End If
            Sheets("Template").Activate
        ReDim Preserve cBox(UBound(cBox) - 1)
            Sheets("RiskRegister").Activate
        If Not .AutoFilterMode Then
            .Range("A1").AutoFilter
            .Range("A1:I" & LR).AutoFilter Field:=1, Criteria1:=Array(cBox), Operator:=xlFilterValues
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Sub CopySheet()

    Dim s As String
    Dim objcBox As Object
    
  Application.ScreenUpdating = False
  
  s = Sheets("Template").objcBox.Object.Caption
  Sheets("RiskRegister").Copy
  With ActiveSheet.ListObjects(1).Range
    If s <> "" Then
      .AutoFilter Field:=1, Criteria1:="<>" & s
      .Offset(1).EntireRow.Delete
    End If
    .AutoFilter Field:=1
  End With
  
  Application.ScreenUpdating = True
  
  Workbooks("SWMS.xlsm").Activate
  Sheets("Template").Activate
  ActiveSheet.CheckBoxes.Value = False

End Sub

Behind Template Sheet:

Private Sub cmdSWMS_Click()
    
    Call Copyme

End Sub


Private Sub CheckBox1_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox2_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox3_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox4_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox5_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox6_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox7_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox8_Click()
    Call Filter_Me
End Sub
Private Sub CheckBox9_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox10_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox11_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox12_Click()
    Call Filter_Me
End Sub
Private Sub CheckBox13_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox14_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox15_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox16_Click()
    Call Filter_Me
End Sub
Private Sub CheckBox17_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox18_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox19_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox20_Click()
    Call Filter_Me
End Sub
Private Sub CheckBox21_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox22_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox23_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox24_Click()
    Call Filter_Me
End Sub
Private Sub CheckBox25_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox26_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox27_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox28_Click()
    Call Filter_Me
End Sub
Private Sub CheckBox29_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox30_Click()
    Call Filter_Me
End Sub

Private Sub CheckBox31_Click()
    Call Filter_Me
End Sub

Thanks,

BellaEC

 

[dmt32]

Hi,
Not tested but see if this update to your Filter code does what you want:

Option Explicit
Sub Filter_Me()
    Dim LR As Long
    Dim i As Integer
    Dim objcBox As Object
    Dim cBox() As Variant


    
    Application.ScreenUpdating = False
    
        For Each objcBox In ThisWorkbook.Worksheets("Template").OLEObjects
            If TypeName(objcBox.Object) = "CheckBox" Then
                If objcBox.Object.Value Then
                    ReDim Preserve cBox(i)
                   cBox(i) = objcBox.Object.Caption
                    i = i + 1
                End If
            End If
        Next
        
    With Sheets("RiskRegister")
            .AutoFilterMode = False
            
        LR = .Cells.Find("*", .Cells(Rows.Count, .Columns.Count), _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        
            .Range("A1").AutoFilter
            If Len(Join(cBox)) > 0 Then
                .Range("A1:I" & LR).AutoFilter Field:=1, Criteria1:=Array(cBox), Operator:=xlFilterValues
            Else
                MsgBox "Nothing Selected", 48, "Nothing Selected"
            End If
    End With
    Application.ScreenUpdating = True
End Sub

Dave

 

[BellaEC]

Hi Dave,

You are fantastic, that is amazing.
The only thing is its only selecting one option at the minute, one 2 options are ticked only the first is only ever executed, is that possible?

Thanks so much,
Eimear

 

[BellaEC]

Ah! I put the call filters behind both sheet code & now its filtering as it should, thank you so much for all your help