Please, use the next approach:
- Insert a class module and name it ChkBClass. Then, paste the next code in it:
Option Explicit
Public WithEvents cBEvent As MSForms.CheckBox
Private Sub cBEvent_Click()
Dim ws As Worksheet, cbNo As Long, arrGr, i As Long
Set ws = cBEvent.Parent 'the sheets where the clicked check box belongs
cbNo = Mid(cBEvent.name, 3) 'the numeric part of the clicked check box
arrGr = WhichGroup(cbNo) 'the array of the group elements where the clicked check box belongs
Debug.Print Join(arrGr(0), "|") 'only to visually see that it is correct...
If cBEvent.value = True Then 'only if the clicked text box became true:
Application.EnableEvents = False 'to avoit the other check boxes being unchecked to trigger events
For i = LBound(arrGr(0)) To UBound(arrGr(0))
If arrGr(0)(i) <> cbNo Then 'all check boxes from the group, except this owne will be unticked:
ws.OLEObjects("CB" & arrGr(0)(i)).Object.value = False
End If
Next i
'write the correct specfic number in correct AW row:
ws.Range(retAddress).Offset(arrGr(1) - 1).value = Application.match(cbNo, arrGr(0), 0) - 1
Application.EnableEvents = True
End If
End Sub
- Declare the next variables on top of a standard module (in the declarations area):
Private chkBArr() As New ChkBClass
Private arrGroups
Public Const retAddress As String = "AW4"
To rename all check boxes on the pattern you defined, please copy the next code in the same standard module as the above declarations (only to be all the staff in the same area...):
Sub renameChkBoxes()
Dim olObj As OLEObject, ws As Worksheet
Set ws = ActiveSheet
For Each olObj In ws.OLEObjects
If TypeName(olObj.Object) = "CheckBox" Then
If Len(olObj.name) >= 9 Then
olObj.name = "CB" & Mid(olObj.name, 9)
olObj.Object.Caption = olObj.name
End If
End If
Next
End Sub
It will rename all check boxes having the name using the pattern "CheckBox###", where the numeric part (###) should be in the interval 1 to 414.
If there are some other check boxes you want to use in a different scope, the above code can be adapted to exclude them.
Run the above code and see the result. Take care, that in the next steps the code will place in an array all the intervals of 6 such check boxes. As 1-6, 7-12 and so on. If the total number of check boxes will not be multiple of six, some problems may appear... The code does not check this aspect, so you must do it.
- Now the part which allocate a similar event to all check boxes in discussion:
Please, copy the next code in the same standard module where you declared the variables (issue 2):
Sub AssignChkBoxClickEvent()
Dim ws As Worksheet, k As Long, oObj As OLEObject
Set ws = ActiveSheet 'use here your necessary sheet
'Worksheets("your worksheet name")
ReDim chkBArr(ws.Shapes.count) 'maximum shapes to be processed
For Each oObj In ws.OLEObjects
If TypeName(oObj.Object) = "CheckBox" Then
'exclude check boxes you need to be excluded from this common event (if the case):
If (oObj.name <> "CheckBox_x") And (oObj.name <> "CheckBox_Y") Then
Set chkBArr(k).cBEvent = oObj.Object: k = k + 1 'place the check box object in the class array!
End If
End If
Next
ReDim Preserve chkBArr(k - 1) 'keep only the above processed check boxes...
End Sub
It assigns the class click event to all click boxes. Run it (for testing reason)!
This Sub should be called from Workbook_Open event, when the respective workbook is open!
Now, copy the rest of code (in the same standard module). Fist Sub load in an array all possible groups of 6 check boxes and the Function is called from the class, determining the group where from the clicked check box belongs:
Sub loadArrGroups()
Dim nrChkBoxes As Long, i As Long, iStart As Long
nrChkBoxes = 414
iStart = 1
ReDim arrGroups(nrChkBoxes / 6 - 1)
For i = 0 To UBound(arrGroups)
arrGroups(i) = iStart & ":" & iStart + 5
iStart = iStart + 6
Next i
'Debug.Print Join(arrGroups, "|") 'uncomment to visually see its return
End Sub
Function WhichGroup(chkbNo As Long) As Variant
If IsEmpty(arrGroups) Then loadArrGroups
Dim El, arr, mtch, i As Long
For Each El In arrGroups
i = i + 1
arr = Evaluate("ROW(" & El & ")")
mtch = Application.match(chkbNo, arr, 0)
If Not IsError(mtch) Then
WhichGroup = Array(Application.Transpose(arr), i)
Exit Function
End If
Next El
End Function
As I said above, the main sub assigning all check boxes to the common Click event is good to be called from the Workbook Open event (in ThisWorkbook code module) as:
Private Sub Workbook_Open()
AssignChkBoxClickEvent
End Sub
Now run the above Sub manually and start playing with check boxes. Next time you will open the workbook the assignation will be done automatically.
I tried commenting all code lines which you may not understand them. If something still unclear and you like understanding, do not hesitate to ask for clarifications...
I tested the above solution and it works as it should. But until I finished posting here the code I observed that I forgot about writing in "AW" column and adapted the code in parallel with posting here. I think I did not miss anything, but working in such a way I cannot be sure. Anyhow the testing project in my workbook works as it should...
