Use VBA code for enabling checkboxes on multiple rows - excel

Question

enter image description hereI have a spreadsheet that has 3 checkbox options for each row, I have created a VBA to disable the other 2 checkboxes once a checkbox is created (so that only 1 checkbox can be checked), however my solution only works for one row and I need some help in rewriting this so that it will apply to all rows please. (I'm new to VBA).
The code I have used is this:
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
CheckBox2.Value = False
CheckBox2.Enabled = False
CheckBox3.Value = False
CheckBox3.Enabled = False
Else
CheckBox2.Value = False
CheckBox2.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
End If
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
CheckBox1.Value = False
CheckBox1.Enabled = False
CheckBox3.Value = False
CheckBox3.Enabled = False
Else
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox3.Value = False
CheckBox3.Enabled = True
End If
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then
CheckBox1.Value = False
CheckBox1.Enabled = False
CheckBox2.Value = False
CheckBox2.Enabled = False
Else
CheckBox1.Value = False
CheckBox1.Enabled = True
CheckBox2.Value = False
CheckBox2.Enabled = True
End If
End Sub

Answer 1

You should probably just use Radios it would be a lot simpler.
If you are intent on doing this you will need to delete all your boxes and then put this code in. It will create and name your boxes and assign them code on click.
Alright, This needs to go in your Sheet module:
Sub Worksheet_Activate()
'Change Module2 to whatever the module name you are using is.
Module2.ActivateCheckBoxes ActiveSheet
End Sub
This next stuff will go into the module you're referencing from the Worksheet Module.
Sub ActivateCheckBoxes(sht As Worksheet)
If sht.CheckBoxes.Count = 0 Then
CreateCheckBoxes sht
End If
Dim cb As CheckBox
For Each cb In sht.CheckBoxes
'You may be able to pass sht as an object, It was giving me grief though
cb.OnAction = "'Module2.CheckBoxClick """ & cb.name & """, """ & sht.name & """'"
Next cb
End Sub
Sub CreateCheckBoxes(sht As Worksheet)
Dim cell As Range
Dim chkbox As CheckBox
With sht
Dim i As Long
Dim prevrow As Long
prevrow = 0
For Each cell In .Range("B2:D5") 'Change this to whatever range you want.
If prevrow < cell.row Then
prevrow = cell.row
i = 0
End If
Set chkbox = .CheckBoxes.Add(cell.Left, cell.Top, 30, 6)
With chkbox
.name = "CheckBox" & i & "_" & cell.row
.Caption = ""
End With
i = i + 1
Next cell
End With
End Sub
Sub CheckBoxClick(chkname As String, sht As String)
Dim cb As CheckBox
With Worksheets(sht)
For Each cb In .CheckBoxes
If Split(cb.name, "_")(1) Like Split(chkname, "_")(1) And Not cb.name Like chkname Then
cb.Value = -4146
End If
Next cb
End With
End Sub

Answer 2

You do not say anything about your sheet check boxes type... Please, test the next solution. It will be able to deal with both sheet check boxes type:
Copy this two Subs in a standard module:
Public Sub CheckUnCheckRow(Optional strName As String)
Dim sh As Worksheet, s As CheckBox, chK As OLEObject ' MSForms.CheckBox
Set sh = ActiveSheet
If strName <> "" Then
Set chK = sh.OLEObjects(strName) '.OLEFormat.Object
solveCheckRow chK.Object.Value, sh, Nothing, chK
Else
Set s = sh.CheckBoxes(Application.Caller)
solveCheckRow s.Value, sh, s
End If
End Sub
Sub solveCheckRow(boolVal As Long, sh As Worksheet, chF As CheckBox, Optional chK As OLEObject)
Dim s As CheckBox, oObj As OLEObject, iCount As Long
If Not chF Is Nothing Then
For Each s In sh.CheckBoxes
If chF.TopLeftCell.Address <> s.TopLeftCell.Address Then
If s.TopLeftCell.Row = chF.TopLeftCell.Row Then
s.Value = IIf(boolVal = -4146, 1, -4146): iCount = iCount + 1
If iCount = 2 Then Exit Sub
End If
End If
Next
ElseIf Not chK Is Nothing Then
For Each oObj In sh.OLEObjects
If oObj.TopLeftCell.Address <> chK.TopLeftCell.Address Then
If oObj.TopLeftCell.Row = chK.TopLeftCell.Row Then
boolStopEvents = True
oObj.Object.Value = IIf(boolVal = 0, True, False): iCount = iCount + 1
boolStopEvents = False
If iCount = 2 Then Exit Sub
End If
End If
Next
End If
End Sub
For case of Form check boxes type:
a). Manually assign the first sub to all your Form Type check boxes (right click - Assign Macro, choose CheckUnCheckRow and press OK).
b). Automatically assign the macro:
Dim sh As Worksheet, s As CheckBox
Set sh = ActiveSheet ' use here your sheet keeping the check boxes
For Each s In sh.CheckBoxes
s.OnAction = "'" & ThisWorkbook.Name & "'!CheckUnCheckRow"
Next
End Sub
If your check boxes have already assigned a macro, adapt CheckUnCheckRow, in Form check boxes section, to also call that macro...
For case of ActiveX check boxes:
a). Create a Public variable on top of a standard module (in the declarations area):
Public boolStopEvents
b). Manually adapt all your ActiveX check boxes Click or Change event, like in the next example:
Private Sub CheckBox1_Click()
If Not boolStopEvents Then CheckUnCheckRow "CheckBox1"
End Sub
Private Sub CheckBox2_Click()
If Not boolStopEvents Then CheckUnCheckRow "CheckBox2"
End Sub
Private Sub CheckBox3_Click()
If Not boolStopEvents Then CheckUnCheckRow "CheckBox3"
End Sub
and so on...
c). Or do all that with a click, using the next piece of code:
Sub createEventsAllActiveXCB()
Dim sh As Worksheet, oObj As OLEObject, strCode As String, ButName As String
Set sh = ActiveSheet 'use here your sheet keeping ActveX check boxes
For Each oObj In sh.OLEObjects
If TypeName(oObj.Object) = "CheckBox" Then
ButName = oObj.Name
strCode = "Private Sub " & ButName & "_Click()" & vbCrLf & _
" If Not boolStopEvents Then CheckUnCheckRow """ & ButName & """" & vbCrLf & _
"End Sub"
addClickEventsActiveXChkB sh, strCode
End If
Next
End Sub
Anyhow, the code cam be simplified in order to deal with only a type of such check boxes. If you intend to use it and looks too bushy, I can adapt it only for the type you like. Like it is, the code deals with both check box types, if both exist on the sheet...
Save the workbook and start playing with the check boxes. But, when you talk about check boxes on a row, all tree of them must have the same TopLeftCell.Row...