Search code examples
excelvbaclasscheckboxcaption

Count ticked checkbox


Following on from this working example: VBA: Execute code when CheckBox is checked/uncheck, I now want to count how many ticked checkboxes per choice. However, I need to count and display "Mum" count and "Dad" count as one choice and "Mum & Dad" count as a second count.

I've declared 2 additional variables:

Dim counter_MoD As Long
Dim counter_MaD As Long

I've added 4 labels to UserForm:

'create labels for counter
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MoD")
        With txtBox
            .Caption = "Amount of selected ''Mum'' or ''Dad'': " '& counter_MoD
            .Left = 390
            .width = 150
            .Top = 3
            .Height = 9
        End With
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MoD_no")
        With txtBox
            .Caption = counter_MoD
            .TextAlign = 3
            .Left = 530
            .width = 10
            .Top = 3
            .Height = 9
        End With
        Sheets(1).Cells(14, 5).Value = counter_MoD
        
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MaD")
        With txtBox
            .Caption = "Amount of selected ''Mum & Dad'': " '& counter_MaD
            .Left = 390
            .width = 150
            .Top = 14
            .Height = 9
        End With
        Set txtBox = Controls.Add("Forms.Label.1", "Counter_MaD_no")
        With txtBox
            .Caption = counter_MaD
            .TextAlign = 3
            .Left = 530
            .width = 10
            .Top = 14
            .Height = 9
        End With
        Sheets(1).Cells(15, 5).Value = counter_MaD

I've altered HandleCheckboxClick to:

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
    'NEW CODE
'if "Mum" is selected, update counter
        If rw2 = rw And mp2 = mp And col = 1 And col2 = 1 Then
            counter_MoD = Sheets(1).Cells(14, 5).Value
            counter_MoD = IIf(isOn, counter_MoD + 1, counter_MoD - 1)
            '#1
'Options.Controls("Counter_MoD_no").Caption = counter_MoD 
            Sheets(1).Cells(14, 5).Value = counter_MoD
        End If
        'if "Dad" is selected, update (same) counter
        If rw2 = rw And mp2 = mp And col = 2 And col2 = 2 Then
            counter_MoD = Sheets(1).Cells(14, 5).Value
            counter_MoD = IIf(isOn, counter_MoD + 1, counter_MoD - 1)
'#2
'Options.Controls("Counter_MoD_no").Caption = counter_MoD
            Sheets(1).Cells(14, 5).Value = counter_MoD
        End If
        'if "Mum & Dad" is selected, update counter
        If rw2 = rw And mp2 = mp And col = 3 And col2 = 3 Then
            counter_MaD = Sheets(1).Cells(15, 5).Value
            counter_MaD = IIf(isOn, counter_MaD + 1, counter_MaD - 1)
                'update label
                    Options.Controls("Counter_MaD_no").Caption = counter_MaD
            Sheets(1).Cells(15, 5).Value = counter_MaD
        End If

    Next cb2
'#3
'Options.Controls("Counter_MoD_no").Caption = counter_MoD
End Sub

I can display the MaD counter and update it.

However, MoD counter can be increased (as in: Sheets(1).Cells(14, 5).Value shows right number of ticks), but when I call to display on UserForm in either position #1, #2 or #3 - all give me the same Debug message: "Could not find the specified object"; pointing to frm.HandleCheckboxClick cb 'call code in the parent form in clsCB. Where do I need to insert code and how to alter?


Solution

  • A useful approach here might be to make a more-capable event handling class, which instead of modelling a single checkbox, has 3 checkboxes to represent one "row" in your table of checkboxes:

    Add a new class module named clsCbRow:

    Option Explicit
    
    'just using public fields...
    Public frm As UserForm1  '<< use the name of your form here...
    
    Public WithEvents cbM As msforms.CheckBox    '<< the 3 checkboxes on a row
    Public WithEvents cbD As msforms.CheckBox
    Public WithEvents cbMaD As msforms.CheckBox
    
    Private Sub cbM_Change()  '<< handle the click event for each checkbox
        HandleClick cbM
    End Sub
    Private Sub cbD_Change()
        HandleClick cbD
    End Sub
    Private Sub cbMaD_Change()
        HandleClick cbMaD
    End Sub
    
    'if `cb` is checked then uncheck the other checkboxes, and update counts
    Private Sub HandleClick(cb As msforms.CheckBox)
        Dim isOn As Boolean, obj
        isOn = (cb.Value)
        If isOn Then
            For Each obj In Array(Me.cbM, Me.cbD, Me.cbMaD)
                If Not obj Is cb Then obj.Value = False 'uncheck other checkboxes
            Next obj
        End If
        frm.UpdateCounts '<<< call the form code to update the counts
    End Sub
    
    'couple of properties for counting "mum or dad" and "mum and dad"
    Property Get MumOrDad() As Boolean
        MumOrDad = cbM.Value Or cbD.Value
    End Property
    Property Get MumAndDad() As Boolean
        MumAndDad = cbMaD.Value
    End Property
    

    This greatly reduces the complexity of your main form code. A very basic implementation:

    Option Explicit
    
    Dim colCBRows As Collection 'collection of "row" objects
    
    Private Sub UserForm_Initialize()
        Dim r As Long
        
        Set colCBRows = New Collection
        
        '10 rows of 3 checkboxes...
        For r = 1 To 10
            Dim cbM As msforms.CheckBox, cbD As msforms.CheckBox, cbMaD As msforms.CheckBox
            Set cbM = AddCheckbox("cbM" & r, "Mum", 20 * r, 20)
            Set cbD = AddCheckbox("cbD" & r, "Dad", 20 * r, 60)
            Set cbMaD = AddCheckbox("cbMaD" & r, "Mum+Dad", 20 * r, 100)
            colCBRows.Add GetHandler(cbM, cbD, cbMaD) 'create the "row" event handler object and add to `colCBRows`
        Next r
        UpdateCounts 'initialize counts
    End Sub
    
    'return a configured instance of clsCB
    Function GetHandler(cbM As msforms.CheckBox, cbD As msforms.CheckBox, cbMaD As msforms.CheckBox) As clsCbRow
        Set GetHandler = New clsCbRow
        Set GetHandler.cbM = cbM
        Set GetHandler.cbD = cbD
        Set GetHandler.cbMaD = cbMaD
        Set GetHandler.frm = Me  'for the callback...
    End Function
    
    'utility function to add and configure a checkbox
    Function AddCheckbox(cbName As String, cbCaption, cbTop As Long, cbLeft As Long) As msforms.CheckBox
        Dim cb As msforms.CheckBox
        Set cb = Me.Controls.Add("Forms.CheckBox.1", cbName)
        cb.Caption = cbCaption
        cb.Top = cbTop
        cb.Left = cbLeft
        Set AddCheckbox = cb
    End Function
    
    'called from clsCbRow whenever a checkbox is clicked
    Sub UpdateCounts()
        Dim MorD As Long, MandD As Long, obj As clsCbRow
        For Each obj In colCBRows 'check each row of checkboxes
            If obj.MumOrDad Then MorD = MorD + 1
            If obj.MumAndDad Then MandD = MandD + 1
        Next obj
        'display counts
        Me.lblCounts.Caption = "Mum or dad = " & MorD & _
                        vbLf & "Mum and Dad = " & MandD
    End Sub
    

    Example of the running form:

    running userform