asked on

Adding multiple choices to a "Check Box"

EE Pros,

EE Pro MartinLiss helped write some code that has been very helpful in building out a check box selection on a worksheet. I'm trying to get the box to now cycle through three stages;
1.) A check
2.) An X
3.) A Question Mark

By clicking on the box, the proper letter is exposed and then based on the font, will display the appropriate sign.

That's it!

Here is the code being used now:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Provides check button
If Target.Column = 5 Then

Application.ScreenUpdating = False
With ActiveCell
If .Value = "P" Then
.Value = ""
.Offset(0, 4).ClearContents
ElseIf .Offset(0, 1).Value <> "" Then
.Font.Name = "Wingdings 2"
.Value = "P"
.Offset(0, 4).FormulaR1C1 = "" '"=Value" 'Value is not a defined name
End If

End With
Cancel = True
Application.ScreenUpdating = True
End If

If Target.Column = 4 Then
If ActiveCell.Offset(0, -3).Value = "2" Then

Application.ScreenUpdating = False
With ActiveCell
If .Value = "P" Then
.Value = ""
ElseIf .Offset(0, 1).Value <> "" Then
.Font.Name = "Wingdings 2"
.Value = "P"
End If

End With
Cancel = True
Application.ScreenUpdating = True

End If
End If

If Target.Column = 3 Then
If ActiveCell.Offset(0, -2).Value = "1" Then

Application.ScreenUpdating = False
With ActiveCell
If .Value = "P" Then
.Value = ""
ElseIf .Offset(0, 1).Value <> "" Then
.Font.Name = "Wingdings 2"
.Value = "P"
End If

End With
Cancel = True
Application.ScreenUpdating = True

End If
End If
End Sub

Thank you in advance,

B.

Martin Liss

Try the attached. If you also need to clear any other cells on the row please let me know.
28691217.xlsm

Bright01

ASKER

Martin,

Great! Looks like you broke the code. However, ..... it only works in the first three cells and if you use the "Clear Button", it doesn't re-establish the macro capability. But you are clearly on the right track!!!!

B.

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Bright01

ASKER

Martin,

THAT IS "WAY COOL"!!!! I don't know how you figured out how to do it but what an outstanding, innovative addition!

As always, appreciate your willingness to jump into these opportunities and always appreciate your skills and capabilities.

Much thanks,

B.

Martin Liss

You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015

Bright01

ASKER

Martin,

If I wanted to add one more "click" that goes back to "blank", how would I add the 3 lines to make the last click go back to "blank"?

Private Sub Toggle(cel As Range)
Application.ScreenUpdating = False

Select Case cel.Value
Case "P" ' It's a checkmark so change to !
cel.Font.Name = "Calibri"
cel = "?"
Case "?" ' it's an ? so change it to X
cel.Font.Name = "Wingdings 2"
cel = "O"
Case "O" ' It's an X so change it to a checkmark
cel.Font.Name = "Wingdings 2"
cel = "P" ' This is a checkmark in the Wingding 2's font
Case Else
If cel.Value = "" Then
cel.Font.Name = "Wingdings 2"
cel = "P" ' This is a checkmark in the Wingding 2's font
End If
End Select
Application.ScreenUpdating = True

End Sub

Thank you!

B.

Martin Liss

Private Sub Toggle(cel As Range)
     Application.ScreenUpdating = False
    
     Select Case cel.Value
        Case "P" ' It's a checkmark so change to ?
            cel.Font.Name = "Calibri"
            cel = "?"
        Case "?" ' it's an ? so change it to X
            cel.Font.Name = "Wingdings 2"
            cel = "O"
        Case "O" ' It's an X so change it to a blank
            cel = ""
        Case "" ' It's blank so change it to a checkmark
            cel.Font.Name = "Wingdings 2"
            cel = "P" ' This is a checkmark in the Wingding 2's font
    End Select
    Application.ScreenUpdating = True

End Sub

Open in new window

Martin Liss

In case you didn't catch it I updated the above to remove the "Case Else" since it's now redundant.

Adding multiple choices to a &quot;Check Box&quot;

Adding multiple choices to a "Check Box"