Please Help with Checkbox Alternative

[PatDudow]

I have not used VBA in years, after much frustration with a project I am working on, I found an example of how to create checkboxes in excel using VB and the font Marlett. I can not tell you how much of a help this was.
The only issue I am still having is how to make a group of 3 mutually exclusive checkboxes default to one if none are checked.


Basically in the example named CheckBox Alternative submitted by lenze, there are a group of checkboxes in this case D2,D4,D6 that you can only choose one of as it clears the other two. I need to add a line somehow that would make D6 the default and show it checked, if the user does not select any of the three.

Any help would be appreciated.

:banghead:

[lucas]

Hi Pat, welcome to the board.

could you post the code you are using? When you post, select the code and hit the vba button to format it for the forum.

[PatDudow]

'Code for Worksheet "Cells as Checkboxes"



Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("myChecks")) Is Nothing Then Exit Sub
'set Target font tp "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets Target Value = ""
Cancel = True
Exit Sub
End If
End Sub


Code for Worksheet "Mutually Exclusive examples"


Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Target.ClearContents 'Sets target Value = ""
Cancel = True
Exit Sub
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Select a specific subset of the range "Ckboxes"
Select Case Target.Address
Case Is = "$D$2", "$D$4", "$D$6"
'Clear Contents of cells that are not the target
If Target.Address = "$D$2" Then [D4,D6].ClearContents
If Target.Address = "$D$4" Then [D2,D6].ClearContents
If Target.Address = "$D$6" Then [D2,D4].ClearContents
'Place the address of the "checked" cell in "$D$11" Range("$D$11").Value = Target.Address Case Is = "$H$3", "$H$5"
'Clear Contents of cells that are not the target
If Target.Address = "$H$3" Then [H5,H5].ClearContents
If Target.Address = "$H$5" Then [H3,H3].ClearContents
'Place the address of the "checked" cell in "$H$11"
Range("$H$11").Value = Target.Address
Case Else
'Populate the cell to the right of Target with its status
If Target.Value = "a" Then
Target.Offset(0, 1) = "Checked"
Else:
Target.Offset(0, 1).Value = "Not Checked"
End If
End Select
End Sub

[lucas]

I looks like the named range myChecks is in column D.

It would help if you could attach your workbook by clicking on go advanced and scroll down and attach your workbook where it says manage attachments.

This appears to be an excel problem. If you could confirm that I will move your thread to the Excel help forum.

[lucas]

In the meantime maybe this will help. When the sheet is activated the letter a is put in D6:

this goes in the code module for the sheet.


Private Sub Worksheet_Activate()
Range("D6").Value = "a"
End Sub

It could be put in workbook open in the thisworkbook module if that would be better.....

[PatDudow]

Thank you for your help,
Excel is the application that I am having the trouble with, I will post the spreadsheet and highlight the areas I am having trouble with.

[lucas]

moved to the Excel help forum

[GTO]

Greetings Pat,

I am not sure I was totally understanding the goals in areas two and four. So a bit of guessing, but see if this helps.

Rather than test against the one named range, I defined four: Group_01 for Range("G5:G8"), Group_02 for Range("G10:G18") and so on for the four ranges of interest.

In the Worksheet Module:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Application.Intersect(Target, _
Application.Union(Range("Group_01"), Range("Group_02"), Range("Group_03"), Range("Group_04"), )) Is Nothing Then
Exit Sub
End If
Cancel = True
Select Case True
Case Not Application.Intersect(Target, Range("Group_01")) Is Nothing
If Target.Value = "a" Then
Target.ClearContents
If Not RangeNotEmpty(Range("Group_01")) Then
Range("G5").Value = "a"
End If
Else
Range("Group_01").ClearContents
Target.Value = "a"
End If
'group with children. Need to make the default G17 if either G10,G12 or G17 are selected.
Case Not Application.Intersect(Target, Range("Group_02")) Is Nothing
If Target.Value = "a" Then
Target.ClearContents
If RangeNotEmpty(Range("G10,G12")) Then
Range("G17").Value = "a"
End If
Else
Range("Group_02").ClearContents
Target.Value = "a"
If RangeNotEmpty(Range("G10,G12")) Then
Range("G17").Value = "a"
End If
End If
Case Not Application.Intersect(Target, Range("Group_03")) Is Nothing
If Target.Value = "a" Then
Target.ClearContents
If Not RangeNotEmpty(Range("Group_03")) Then
Range("G22").Value = "a"
End If
Else
Range("Group_03").ClearContents
Target.Value = "a"
End If
'If G29 or G30 is checked, check G28. Is there a way not to let them
'uncheck G28 (parent) if G29 and G30 (Children are selected)?
Case Not Application.Intersect(Target, Range("Group_04")) Is Nothing
If Target.Value = "a" Then
Target.ClearContents
If RangeNotEmpty(Range("G29:G30")) Then
Range("G28").Value = "a"
End If
Else
Range("Group_04").ClearContents
Target.Value = "a"
If RangeNotEmpty(Range("G29:G30")) Then
Range("G28").Value = "a"
End If
End If
End Select
End Sub

Private Function RangeNotEmpty(rng As Range) As Boolean
Dim r As Range
For Each r In rng
If r.Value = "a" Then
RangeNotEmpty = True
Exit Function
End If
Next
End Function


The above assumes the font has already been changed. I hope I didn't 'swing and miss' at the start, but I could not see how Target.Count could be anything other than 1?

Hope this helps,

Mark

[PatDudow]

Excellent, Thanks for the help!
Patty

[GTO]

Hi Patty,

:fainted: If I got the second and last section correct, I am pleasantly surprised. If after testing, that proves correct, please mark the thread as Solved, which you can do from Thread Tools atop your first post.

Of course if you test and find an oversight, please post back.

To echo my buddy Steve, Welcome! I joined a couple of years ago after 'lurking' and learning an awful lot in just reading others. It is to my chagrin that I delayed in joining, as there's just some mighty fine folks here :-)

A great day to you and yours,

Mark