Applying mutually exclusive checkboxes

[gailb]

In the attachment provided, I'm using the DoubleClick method to add a "checkmark" to the cell that is the right answer on the quiz.

So far, I've added a named range to apply to the cells and updated the code so the user can only pick one answer. This works so far, but before I go any farther, is there a more efficient way to do it? Code is updated for C6:C9 and C14:C17.

I have multiple quizzes I'll be creating and every one of them has a different length; however, they are answered in column C. Also, most questions have four possible choices, but there will be some with only two choices.

_Template - Copy.xlsm

[HansV]

See the attached version. It looks at the fill color of the cells to determine which cells belong together, so you only have to color the cells correctly and define the Ckboxes range.

_Template - Copy.xlsm

[gailb]

This will work great Hans. Thank you.

[gailb]

Hi Hans,

A follow-up question. How can I add all of the colored cells to the named range with VBA? I'm going to change the double click cells to interior.colorindex = 19, and would like to search for that colorindex and add those cells to the named range Ckboxes.

Here is what I'm using to change those cells to "Marlett", just not sure how to add each of the loops into a named range.

Code: Select all

Sub ChangeYellowFont()
    Dim MyCell As Range
    For Each MyCell In Sheet1.Range("C6:C100")
        If MyCell.Interior.ColorIndex = 19 Then MyCell.Font.Name = "Marlett"
    Next MyCell
End Sub

[HansV]

Try this:

Code: Select all

Sub ChangeYellowFont()
    Dim MyCell As Range
    Dim CkBoxes As Range
    For Each MyCell In Sheet1.Range("C6:C100")
        If MyCell.Interior.ColorIndex = 19 Then
            If CkBoxes Is Nothing Then
                Set CkBoxes = MyCell
            Else
                Set CkBoxes = Union(CkBoxes, MyCell)
            End If
        End If
    Next MyCell
    CkBoxes.Font.Name = "Marlett"
    On Error Resume Next
    ActiveWorkbook.Names("Ckboxes").Delete
    On Error GoTo 0
    ActiveWorkbook.Names.Add Name:="Ckboxes", RefersTo:="=Sheet1!" & CkBoxes.Address
End Sub

[gailb]

Thank again, works great.