Number of possible picks in a group of checkboxes depending on another checkbox

[Holy Inquisitor]

Hello All,

I need your insights how to improve my VBA code further as it is not working completly as I intended:

Basic information:
- Multiple rows with up to 10 groups of checkboxes
- Rows must not have all 10 groups
- Checkboxes in the same group are the same in each row (ie. naming: chkboxA0001, chkboxB0001, chkboxC0001 in line 1, chkboxA0002, chkboxB0002 in line 2 etc)
- The checkboxes in each groups are mutualy exclusive like radio buttons, but this way they can be unchecked
- A few rows can have an additional checkbox which is not part of any of the groups. If this checkbox is checked a specific group in the same row can have up to maximum 2; or another group up to maximum 3 checkboxes checked, so they are no longer mutualy exclusive as long as this additional checkbox is checked. Once the checkbox is unchecked the group should be mutualy exclusive again
- The OnePickOnly or TwoPicksOnly subs are called individually from each line's checkboxgroups

Status:
- mutualy exclusive groups - working
- multiple checkboxes available if the additional checkbox is checked - more or less working, the checkcount part is inaccurate
- enabling unchecked cells again once a checkbox is unchecked after reaching the maximum allowed checks - not working, probably due to the inaccurate checkcounts
- returning to mutually exclusive groups again once the additional checkbox is unchecked - not working

Any help or advice would be greatly appreciated.


Here is the code up to now:


Private Sub OnePickOnly(sGroup As String, sName As String)

Dim ole As OLEObject

For Each ole In Me.OLEObjects
If TypeName(ole.Object) = "CheckBox" Then
If ole.Object.GroupName = sGroup And ole.Name <> sName Then
ole.Object.Value = False
End If
End If
Next ole

End Sub


Private Sub TwoPicksOnly(sGroup As String, sName As String)
Dim ole As OLEObject
Dim CheckedCount As Integer
CheckedCount = 0
For Each ole In Me.OLEObjects
If TypeName(ole.Object) = "CheckBox" Then
If ole.Object.GroupName = sGroup And ole.Object.Value = True Then CheckedCount = CheckedCount + 1
ElseIf ole.Object.GroupName = sGroup And ole.Object.Value = False Then CheckedCount = CheckedCount - 1 ' I think this part is not working properly
End If
If CheckedCount >= 2 And ole.Object.Value = False Then ole.Object.Enabled = False
If CheckedCount < 2 And ole.Object.Value = False Then ole.Object.Enabled = True ' I think this part is also not working
Next ole
End Sub



Private Sub AdditionalCheckbox0101_Change()

End Sub


Group of checkboxes with mutualy exclusive or 2-pick options


Private Sub ChkboxA0101_Click()

If AdditionalCheckbox0101 = False Then
With Me.ChkboxA0101
If .Value Then OnePickOnly .GroupName, .Name
End With
Else
With Me.ChkboxA0101
If .Value Then TwoPicksOnly .GroupName, .Name
End With
End If
End Sub


Private Sub ChkboxB0101_Click()

If AdditionalCheckbox0101 = False Then
With Me.ChkboxB0101
If .Value Then OnePickOnly .GroupName, .Name
End With
Else
With Me.ChkboxB0101
If .Value Then TwoPicksOnly .GroupName, .Name
End With
End If
End Sub

Private Sub ChkboxC0101_Click()

If AdditionalCheckbox0101 = False Then
With Me.ChkboxC0101
If .Value Then OnePickOnly .GroupName, .Name
End With
Else
With Me.ChkboxC0101
If .Value Then TwoPicksOnly .GroupName, .Name
End With
End If
End Sub

Private Sub ChkboxD0101_Click()

If AdditionalCheckbox0101 = False Then
With Me.ChkboxD0101
If .Value Then OnePickOnly .GroupName, .Name
End With
Else
With Me.ChkboxD0101
If .Value Then TwoPicksOnly .GroupName, .Name
End With
End If
End Sub

Private Sub ChkboxE0101_Click()

If AdditionalCheckbox0101 = False Then
With Me.ChkboxE0101
If .Value Then OnePickOnly .GroupName, .Name
End With
Else
With Me.ChkboxE0101
If .Value Then TwoPicksOnly .GroupName, .Name
End With

End If
End Sub