Search code examples
excelvbaclasscheckbox

VBA: Execute code when CheckBox is checked/uncheck


I have a Userform where you might select from a list of activities (but don't need to). Per line, you have 4 options to choose who to do the activity with. Therefore, I created 4 checkboxes per line which represent Mum, Dad, parents, myself. I want the other checkboxes (in that activity line) to disappear if you selected an option.

What I want to achieve

However, answers for ToggleButton and Textboxes (VBA: Using WithEvents on UserForms) didn't help so far.

Private Sub UserForm_Initialize()
Dim chkBox      As MSForms.Checkbox
Dim opt As Long 'Sheets
Dim i           As Long 'activities per sheet

For opt = 3 To Sheets.Count
    lastRow = Sheets(opt).Cells(Rows.Count, curColumn).End(xlUp).row
    For i = 1 To lastRow - 1
            Set chkBox = MultiPage1.Pages(opt - 3).Controls.Add("Forms.CheckBox.1", "CheckBox_" & opt & "_1_" & i) 'create activity and myself checkBox
        chkBox.Caption = Sheets(opt).Cells(i + 1, 1).Value 'A, C, C in my screenshot
       
         For c = 2 To 4 'create fields for Mum, Dad, Parents
        Set chkBox = MultiPage1.Pages(opt - 3).Controls.Add("Forms.CheckBox.1", "CheckBox_" & opt & "_" & c & "_" & i)
       Next c
  Next i
Next opt
End Sub

I've tried:

Dim MyArray()   As Integer
'Dim cmdCBArray() As New clsRunTimeCheckBox
Private m_oCollectionOfEventHandlers As Collection
Set m_oCollectionOfEventHandlers = New Collection

    Dim oControl As Control
    For Each oControl In Options.Controls
'        MsgBox oControl.Name
        If TypeName(oControl) = "CheckBox" Then
'            MsgBox oControl.TabIndex
            Dim oEventHandler As clsRunTimeCheckBox
            Set oEventHandler = New clsRunTimeCheckBox

'            Set oEventHandler.TextBox = oControl 'error: Method or Data member not found

            m_oCollectionOfEventHandlers.Add oEventHandler

        End If

    Next oControl
'        ReDim Preserve cmdCBArray(1 To MyArray(opt))
'            Set cmdCBArray(c + i).CmdCBEvents = chkBox 'gives error the third time
'            Set chkBox = Nothing

As well as in the classes:

'Public WithEvents CmdCBEvents As MSForms.Checkbox
'
'Private Sub CmdCBEvents_Change()
'    RaiseEvent Change
'End Sub
'
'Public Sub Change()
'    ' Respond to the checkbox change here
'    MsgBox "Checkbox changed!"
'End Sub
Private WithEvents m_oCBox As MSForms.Checkbox

Public Property Set CBox(ByVal oCBox As MSForms.Checkbox)
    Set m_oCBox = oCBox
End Property

Private Sub m_oCBox_Change()
    ' Do something
    MsgBox "Change enabled"
End Sub

Last code above runs (i.e. opens UserForm), but doesn't give me any message boxes when I check any checkboxes.

Question: How do I call changes to CheckBoxes?

Because my checkboxes have specific names, I can then loop the change event:

if CmDEvent is checked Then
   'read out opt, c and i from Name, e.g. = CB_opt_1_i; c = 1
   'set all other c to false
   Activities.Controls(CB_opt_2_i).Enabled = False
   Activities.Controls(CB_opt_3_i).Enabled = False
   Activities.Controls(CB_opt_4_i).Enabled = False

Update after Tim's suggestion

I've just added code for using it within MultiPage and thought I copy here in case somebody is looking for it (clsCB stays the same):

Option Explicit

Dim colCB As Collection

Private Sub UserForm_Initialize()
    Dim cb As MSForms.CheckBox, r As Long, c As Long, S As Long, MultiPage1 As MSForms.MultiPage
    
    Set colCB = New Collection
    
    Set MultiPage1 = Me.Controls.Add("Forms.Multipage.1", "Test") 'creates 2 boxes
    With MultiPage1
        .Height = 150
    End With
    
    For S = 1 To 4
     If S > 2 Then
        MultiPage1.Pages.Add "Page" & S, "Page" & S
    End If
    
    'Five rows of 4 checkboxes... "CheckBox_" & opt & "_1_" & i
    For r = 1 To 5
        For c = 1 To 4
            Set cb = MultiPage1.Pages(S - 1).Controls.Add("Forms.CheckBox.1", "CheckBox_" & S & "_" & c & "_" & r)
            cb.Top = -10 + 20 * r
            cb.Left = -10 + 20 * c
            colCB.Add GetHandler(cb) 'create the event handler object
        Next c
    Next r
    Next S
End Sub

'return a configured instance of clsCB
Function GetHandler(cb As MSForms.CheckBox) As clsCB
    Set GetHandler = New clsCB
    Set GetHandler.cb = cb
    Set GetHandler.frm = Me  'for the callback...
End Function

Sub HandleCheckboxClick(cb As MSForms.CheckBox)
    Dim rw As Long, col As Long, mp As Long, rw2 As Long, col2 As Long, mp2 As Long, isOn As Boolean, cb2
    ResolvePosition cb, rw, col, mp
    isOn = (cb.Value)
    
    For Each cb2 In colCB  'check all of the event-handling objects
        ResolvePosition cb2.cb, rw2, col2, mp2
        'on same row, but not the checked box?
        If rw2 = rw And mp2 = mp And col2 <> col Then
            cb2.cb.Visible = IIf(isOn, False, True)
        End If
    Next cb2
End Sub

'Given a checkbox named "MP_S_Row_X_Col_Y" set `rw` to X and `col` to Y; "CheckBox_" & S & "_" & c & "_" & r
Sub ResolvePosition(cb As MSForms.CheckBox, ByRef rw As Long, ByRef col As Long, ByRef mp As Long)
    Dim arr
    arr = Split(cb.Name, "_")
    rw = arr(3)
    col = arr(2)
    mp = arr(1)
End Sub

Solution

  • Here's a rough example.

    clsCB:

    Option Explicit
    
    'just using public fields...
    Public frm As UserForm1  '<< use the name of your form here...
    Public WithEvents cb As MSForms.CheckBox
    
    Private Sub cb_Change()
        frm.HandleCheckboxClick cb 'call code in the parent form
    End Sub
    

    Userform1:

    Option Explicit
    
    Dim colCB As Collection
    
    Private Sub UserForm_Initialize()
        Dim cb As MSForms.CheckBox, r As Long, c As Long, t As Long, l As Long
        
        Set colCB = New Collection
        t = 10
        
        'Ten rows of 4 checkboxes...
        For r = 1 To 10
            l = 10
            For c = 1 To 4
                Set cb = Me.Controls.Add("Forms.CheckBox.1", "Row_" & r & "_Col_" & c)
                cb.Top = t
                cb.Left = l
                l = l + 20
                colCB.Add GetHandler(cb) 'create the event handler object
            Next c
            t = t + 20
        Next r
    End Sub
    
    'return a configured instance of clsCB
    Function GetHandler(cb As MSForms.CheckBox) As clsCB
        Set GetHandler = New clsCB
        Set GetHandler.cb = cb
        Set GetHandler.frm = Me  'for the callback...
    End Function
    
    Sub HandleCheckboxClick(cb As MSForms.CheckBox)
        Dim rw As Long, col As Long, rw2 As Long, col2 As Long, isOn As Boolean, cb2
        ResolvePosition cb, rw, col
        isOn = (cb.Value)
        
        For Each cb2 In colCB  'check all of the event-handling objects
            ResolvePosition cb2.cb, rw2, col2
            'on same row, but not the checked box?
            If rw2 = rw And col2 <> col Then
                cb2.cb.Visible = IIf(isOn, False, True)
            End If
        Next cb2
    End Sub
    
    'Given a checkbox named "Row_X_Col_Y" set `rw` to X and `col` to Y
    Sub ResolvePosition(cb As MSForms.CheckBox, ByRef rw As Long, ByRef col As Long)
        Dim arr
        arr = Split(cb.Name, "_")
        rw = arr(1)
        col = arr(3)
    End Sub