Consulting

Results 1 to 10 of 10

Thread: Please Help with Checkbox Alternative

  1. #1

    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.


  2. #2
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    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.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  3. #3
    'Code for Worksheet "Cells as Checkboxes"

    [VBA]
    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
    [/VBA]
    [VBA]
    '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
    [/VBA]
    [VBA]
    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
    [/VBA]

  4. #4
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    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.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  5. #5
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    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.
    [vba]
    Private Sub Worksheet_Activate()
    Range("D6").Value = "a"
    End Sub
    [/vba]
    It could be put in workbook open in the thisworkbook module if that would be better.....
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

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

  7. #7
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    moved to the Excel help forum
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  8. #8
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    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

  9. #9
    Excellent, Thanks for the help!
    Patty

  10. #10
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Hi Patty,

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •