PDA

View Full Version : [SOLVED] Looping Through Checkboxes?



zoom38
10-01-2015, 08:20 AM
Hello all, I have a sub that goes thru a group of six checkboxes so that when a checkbox is clicked/checked in that group, the others will be unchecked. I actually have 13 groups of 6 checkboxes to do this for (checkboxes 5 - 82) and am looking to simplify the code so that its not ridiculously long. I thought a loop would do but I can't figure it out. I pondered an array but don't really know my way with them. Is there a way to shorten my code below to accomplish this?



Application.EnableEvents = False
ActiveSheet.Unprotect
'Checkboxes 5-10
If z = 5 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 4).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 5).Object.Value = 0
GoTo a
ElseIf z = 6 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 4).Object.Value = 0
GoTo a
ElseIf z = 7 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 3).Object.Value = 0
GoTo a
ElseIf z = 8 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
GoTo a
ElseIf z = 9 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
GoTo a
ElseIf z = 10 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
GoTo a
End If

a:
ActiveSheet.Unprotect
Application.EnableEvents = True

snb
10-01-2015, 08:22 AM
MS invented OptionButtons for that purpose.

zoom38
10-01-2015, 11:36 AM
Thanks for the tip on the OptionButtons. That works fine but I like the check boxes better, aesthetically that is. So I changed the checkboxes to start at 6 and used the Mod function to get it done. The only issue is the ludicrous number of checkbox click subs in the worksheet module. Below is the sub that works for 13 sets of 6 checkboxes.



Application.EnableEvents = False
ActiveSheet.Unprotect

For x = 1 To 13
If (z) Mod 6 = 0 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 4).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 5).Object.Value = 0
GoTo a
ElseIf z Mod 6 = 1 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 4).Object.Value = 0
GoTo a
ElseIf z Mod 6 = 2 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 3).Object.Value = 0
GoTo a
ElseIf z Mod 6 = 3 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 2).Object.Value = 0
GoTo a
ElseIf z Mod 6 = 4 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 4).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z + 1).Object.Value = 0
GoTo a
ElseIf z Mod 6 = 5 And ActiveSheet.OLEObjects("CheckBox" & z).Object.Value = True Then
ActiveSheet.OLEObjects("CheckBox" & z - 5).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 4).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 3).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 2).Object.Value = 0
ActiveSheet.OLEObjects("CheckBox" & z - 1).Object.Value = 0
GoTo a
End If
Next x

a:
ActiveSheet.Unprotect
Application.EnableEvents = True


Gary

SamT
10-01-2015, 12:04 PM
Assuming that each of the 13 groups has some commonality in their purpose, Then with names like ckbxCommonality1, ckbxCommonality(2-6)


Sub SetCheckBoxes(ckbxName)
Dim Ctrl As Object
For Each Ctrl In ActiveSheet.OLEObjects
BoxName = Mid(ckbxName, 5, Len(ckbxName) - 5)
If InStr(Ctrl.Name, BoxName) <> 0 Then
If Ctrl.Name <> ckbxName Then Ctrl.Value = False
End If
Next CheckBox
End Sub

p45cal
10-01-2015, 05:38 PM
13 groups of checkboxes eh?
Checkboxes have a property called GroupName, so you can set the group names of the checkboxes so that those in a group have the same group name (really that goes without saying).
Then in each checkbox change_event, if that checkbox is true you can call one macro to untick all the other checkboxes in that group. Here's some code (in the sheet concerned's code-module) that could probably be shorter, for 2 groups of 3 checkboxes:
Sub untickOtherCbxesInGrp(cb)
For Each cbox In Me.OLEObjects
If TypeName(cbox.Object) = "CheckBox" Then
If cbox.Object.GroupName = cb.GroupName Then
If cbox.Object Then
If Not cb Is cbox.Object Then cbox.Object.Value = False 'make sure checkbox isn't the one that's just been ticked!
End If
End If
End If
Next cbox
End Sub

Private Sub CheckBox1_Change()
If CheckBox1 Then untickOtherCbxesInGrp CheckBox1
End Sub
Private Sub CheckBox2_Change()
If CheckBox2 Then untickOtherCbxesInGrp CheckBox2
End Sub
Private Sub CheckBox3_Change()
If CheckBox3 Then untickOtherCbxesInGrp CheckBox3
End Sub
Private Sub CheckBox4_Change()
If CheckBox4 Then untickOtherCbxesInGrp CheckBox4
End Sub
Private Sub CheckBox5_Change()
If CheckBox5 Then untickOtherCbxesInGrp CheckBox5
End Sub
Private Sub CheckBox6_Change()
If CheckBox6 Then untickOtherCbxesInGrp CheckBox6
End Sub
I feel there might be a For each cbox in me.checkboxes but it didn't work; it would reduce the need to go through all the sheet's oleobjects.
We're left with the pain of producing an event for each checkbox and you say you have 78. Well this can also be reduced by having a class module for the checkboxes WithEvents, which needs a bit of setting up but you'd then only need one event macro for all the checkboxes. If this is needed then come back.

zoom38
10-01-2015, 07:51 PM
You guys are great, thanks for the help with the alternate methods to solve my problem.

SamT I tried your code but can't get it to work. It stops at: Ctrl.Value = False and gives an "Object doesn't support this property or Method" error message. I tried tweaking it but still couldn't get it to work. I'd like to see it work if you could help me past this.

P45 your code worked great except Me.OLEObjects didn't work. I substituted ActiveSheet.OLEObjects for it which did work.
Is there a difference between CheckBox_Change and CheckBox_Click? I tried them both and couldn't tell, they both worked fine.
I will also look into the class module idea, i'm not familiar with it so I need to do a little research. If I get stuck I'll be back for help.

Thanks
Gary

snb
10-01-2015, 11:47 PM
The class module approach: http://www.snb-vba.eu/VBA_Sheet_ActiveX_controle_en.html

SamT
10-02-2015, 08:06 AM
snb,

You have bad links on that page.

For a description how to do this in a userform see this page. (http://www.snb-vba.eu/VBA_Userform_controle_en.html)
And
Check userform controls using a classmodule (http://www.snb-vba.eu/VBA_userform_invoercontrole_en.html)

Thought you would want to know.

snb
10-02-2015, 08:28 AM
@SamT

Thank you

I only found 1, that I amended.

SamT
10-02-2015, 08:29 AM
Taking a hint from p45cal, (He's a pro, I'm an amateur.)

Note that I moved the BoxName assignment before the loop where it belongs.

Sub SetCheckBoxes(ckbxName)
Dim Ctrl As Object
Dim BoxName As String
BoxName = Mid(ckbxName, 5, Len(ckbxName) - 5)

For Each Ctrl In ActiveSheet.OLEObjects
If InStr(Ctrl.Name, BoxName) <> 0 Then
If Ctrl.Name <> ckbxName Then Ctrl.Object.Value = False
End If
Next CheckBox
End Sub

I think that his Procedure will be slight faster than mine because he is using only native Methods and Properties but I am using a User Defined Property, "BoxName."

p45cal
10-02-2015, 09:48 AM
@SamT

Thank you

I only found 1, that I amended.Nope, there is still a broken link, 5 or 6 lines down from the top, it tries to link to http://www.snb-vba.eu/VBA_Userform_controle_en.html.

snb
10-02-2015, 12:03 PM
@p45cal

Thank you. Also restored (and another one in the page it's referring to backward).