Macro to run anytime a ActiveX checkbox is used (no linked cells)

[esitze]

Hello All!
I have written the code below that does what I want it to do, but it is assigned to 1 ActiveX check box. I would like it to run anytime an ActiveX checkbox is used, but also only effect the one checkbox being activated. Any help or guidance is much appreciated!!! FYI there is over 1000 ActiveX checkboxes on this sheet, and none are linked to a cell for sorting and filtering purposes. Cheers!


Private Sub CheckBox1146_Click()
Set WS3 = Worksheets("Boilermakers")
Dim LRow As Long
Dim obeObj As Object
Application.ScreenUpdating = False

If WS3.Range("H2") = "" Then
For Each obeObj In ActiveSheet.OLEObjects
If TypeName(obeObj.Object) = "CheckBox" Then
If obeObj.Object.Value = True Then
obeObj.Object.Value = False
MsgBox "*** Add Job Number ***"
Range("H2").Select
End If
End If
Next
Application.ScreenUpdating = True
Exit Sub
Else

ThisWorkbook.Unprotect
WS3.Unprotect

For Each obeObj In ActiveSheet.OLEObjects
If TypeName(obeObj.Object) = "CheckBox" Then
If obeObj.Object.Value = True Then
If TypeName(obeObj.Object) = "CheckBox" Then
If obeObj.Object.Value = True Then
LRow = LRow + 1
If Cells(obeObj.TopLeftCell.Row, 47) = "" Then
Cells(obeObj.TopLeftCell.Row, 47).Value = Range("H2").Value
MsgBox "Employee Location Updated"

WS3.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ThisWorkbook.Protect

Else
MsgBox "Employee Already Assigned To A Job"
obeObj.Object.Value = False
WS3.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ThisWorkbook.Protect
End If
End If
Application.ScreenUpdating = True
Exit Sub

WS3.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlUnlockedCells
ThisWorkbook.Protect
End If
End If
End If
Next
End If
Application.ScreenUpdating = True
End Sub

 

[John_w]

I would like it to run anytime an ActiveX checkbox is used, but also only effect the one checkbox being activated. Any help or guidance is much appreciated!!! FYI there is over 1000 ActiveX checkboxes on this sheet

This can be done with a class module which handles the Click event of any ActiveX check box on the sheet.

Add a new Class module, and rename it from Class1 to clsCheckBox:

Public WithEvents mCheckBox As MSForms.CheckBox

'Process Click event for an instance of this class

Private Sub mCheckBox_Click()
   
    MsgBox "Clicked: " & mCheckBox.Caption & ", value = " & IIf(mCheckBox.Value, "Ticked", "Not ticked")
   
End Sub

The above Click handler simply displays the caption and state of the clicked check box. You need to extend the code to include what your CheckBox1146_Click routine is doing or call a separate routine.

Add a new standard module:

Dim CheckBoxColl As Collection

Public Sub Assign_CheckBoxes_Handler()

    Dim objOLE As OLEObject
    Dim thisCheckBox As clsCheckBox
   
    Set CheckBoxColl = New Collection
   
    For Each objOLE In ThisWorkbook.Worksheets("Sheet1").OLEObjects
        If TypeOf objOLE.Object Is MSForms.CheckBox Then
            Set thisCheckBox = New clsCheckBox
            Set thisCheckBox.mCheckBox = objOLE.Object
            CheckBoxColl.Add thisCheckBox
        End If
    Next
           
End Sub

The above routine assigns the class handler to each ActiveX check box on "Sheet1" (change this to your sheet name), and stores each instance of the class (a clsCheckBox object) in a Collection, declared at module-level so that it retains the objects until the workbook is closed or an unhandled error in any VBA code occurs.

In order to create the Collection and class handlers when the workbook is opened, add this code to the ThisWorkbook module:

Private Sub Workbook_Open()
    Assign_CheckBoxes_Handler
End Sub

 

[esitze]

I'm getting a compile error mess in the new module I installed. Any suggestions? The help button takes me to this link...

Compile error in hidden module: <module name>

Office VBA reference topic

learn.microsoft.com

 

[esitze]

Apologies John, I figured out what I missed that triggered the error message. Now I no longer get an error, but it doesn't appear to be working. Any thoughts?

 

[esitze]

John, very sorry. I was rushing through this. After going through your very clear, very accurate instructions again. Your solution works perfectly. Thank you very much for the help. If you find yourself near St. Louis, drinks are on me! Cheers!!!

 

[esitze]

You wouldn't have a suggestion on how to make this code work "singularly" for each check box when "ticked" instead of the way I have it set where it loops through all the objects on the sheet?

 

[John_w]

Describe what your code is doing.

 

[esitze]

If i have multiple check boxes checked, and I uncheck one it will uncheck all of them

 

[John_w]

In that case, I don't think there's any alternative to looping through them.

Private Sub mCheckBox_Click()
    
    Dim objOLE As OLEObject
    
    'MsgBox "Clicked: " & mCheckBox.Caption & ", value = " & IIf(mCheckBox.Value, "Ticked", "Not ticked")
    
    If mCheckBox.Value = False Then
        'This mCheckBox has been unticked, so untick all the other check boxes
        For Each objOLE In ActiveSheet.OLEObjects
            If TypeOf objOLE.Object Is MSForms.CheckBox Then
                objOLE.Object.Value = False
            End If
        Next
    End If
    
End Sub