Please Help with Checkbox Alternative

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:

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.

'Code for Worksheet "Cells as Checkboxes"

Code:

---


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"

Code:

---

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

---

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.

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.

Code:

---


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.....

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.

moved to the Excel help forum

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:

Code:

---

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

Excellent, Thanks for the help!
Patty

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