Only ONE checkbox is available

[Imaginative1]

' Only the final checkbox can be checked. The others are uncheckable. Will I be able to fix this?


' UserForm1 Code
Private Sub CheckBox1_Click()
End Sub
Private Sub cmdBeginQuiz_click()
' MsgBox "cmdBeginQuiz_click()"

Dim quizWorkbook
Set quizWorkbook = ActiveWorkbook

cmdBeginQuiz.Enabled = False

Dim questionMatrix
Set questionMatrix = CreateQuestions(quizWorkbook)

DisplayQuestions questionMatrix
End Sub
Function DisplayQuestions(qMatrix)
' MsgBox "DisplayQuestions()"
Dim qs
Set qs = UserForm1.labelQuestionSpace

Dim fs
Set fs = UserForm1.frameResponses

For i = 1 To qMatrix.Count

fs.Clear

' Question --------------------
qs.Caption = qMatrix.Item(i)(1)

' Potential Responses ---------------------------
Dim potentialResponses
For collectionLoop = 2 To UBound(qMatrix.Item(i))

Set potentialResponses = fs.Controls.Add("Forms.Checkbox.1", "My" & collectionLoop _
& "Control", True)

potentialResponses.Move 0, collectionLoop - 20, 200, collectionLoop * 30

potentialResponses.GroupName = "gribbit"
potentialResponses.Locked = False
potentialResponses.Enabled = True
potentialResponses.Value = False ' checked state

potentialResponses.BackStyle = 0
potentialResponses.AutoSize = False
potentialResponses.Width = 200
potentialResponses.Caption = qMatrix.Item(i)(collectionLoop)

' MsgBox qMatrix.Item(i)(j)

Next collectionLoop

Dim c
For Each c In UserForm1.frameResponses.Controls

' c.Locked = False
' MsgBox c.Caption & vbCr & GroupName

Next

Next i
End Function
Private Sub cmdCloseApp_Click()
cmdBeginQuiz.Enabled = True
Unload Me
End Sub
Private Sub cmdSubmitAnswer_click()
MsgBox "cmdSubmitAnswer_click()"
End Sub
Function CreateQuestions(qWB)
qWB.Sheets("Quiz").Activate

' MsgBox "CreateQuestions(qWB)"

Dim questionVolume As Integer
questionVolume = CreateQIndices(qWB)

Dim quizItemLeft_ As Range ' Locate the leftmost cell in the question
Dim quizItemRight As Range ' Locate the rightmost cell in the question
Dim qRange ' Make a range that spans the cells

Dim qCollection As New Collection

Dim quizItemIndex
For quizItemIndex = 1 To questionVolume

Set quizItemLeft_ = qWB.Sheets("Quiz").Cells(quizItemIndex, 1).End(xlToLeft)
Set quizItemRight = qWB.Sheets("Quiz").Cells(quizItemIndex, 1).End(xlToRight)
Set qRange = qWB.Sheets("Quiz").Range(Cells(quizItemLeft_.Row, quizItemLeft_.Column), _
Cells(quizItemRight.Row, quizItemRight.Column))

qRange.Select

' MsgBox "quizItemIndex: " & quizItemIndex

Dim q: Set q = New QuestionItem
q.ReceiveRow = qRange
qCollection.Add q.currQuestion

' MsgBox "qCollection: " & qCollection.Count

' MsgBox UBound(q.currQuestion)
' MsgBox UBound(q.GetCurrentQuestion)

Next quizItemIndex

Set CreateQuestions = qCollection

End Function
Function CreateQIndices(qWB)
' MsgBox "CreateIndices(qWB)"

' Randomize this number later
Dim quizColumn
Set quizColumn = qWB.Sheets("Quiz").Cells.SpecialCells(xlCellTypeLastCell)

iQIndices = quizColumn.Row
CreateQIndices = iQIndices
End Function
Private Sub UserForm_Click()
End Sub
' QuestionItem Class (Module)
Option Explicit
Private questionUnit As Range
Public currQuestion
Public Property Let ReceiveRow(rowUnit)

Dim arryQuestion As New DynamicArray

BuildQuestionItem rowUnit

Set questionUnit = rowUnit

End Property

Public Property Get GetRow()

Set GetRow = questionUnit

End Property

Public Property Get GetCurrentQuestion()

GetCurrentQuestion = currQuestion
' GetCurrentQuestion = 1

End Property

Public Function BuildQuestionItem(rUnit) ' rUnit = range contents

Dim cQuestion As New DynamicArray

Dim cUnit ' cell contents
For Each cUnit In rUnit

' MsgBox "cUnit: " & cUnit
cQuestion.Data(cUnit.Column) = cUnit

Next

' MsgBox "BuildQuestionItem(): " & rUnit.Columns.Count

currQuestion = cQuestion.DataArray
' MsgBox UBound(currQuestion)

' Set BuildQuestionItem = cQuestion.DataArray

End Function

' DynamicArray Class (Module)
Option Explicit
'************** Properties **************
Private aData
'****************************************
'*********** Event Handlers *************
Private Sub Class_Initialize()
ReDim aData(0)
End Sub
'****************************************
'************ Property Get **************
Public Property Get Data(iPos)
'Make sure the end developer is not requesting an
'"out of bounds" array element
If iPos < LBound(aData) Or iPos > UBound(aData) Then
Exit Property 'Invalid range
End If
Data = aData(iPos)
End Property
Public Property Get DataArray()
DataArray = aData
End Property
'****************************************
'************ Property Let **************
Public Property Let Data(iPos, varValue)
'Make sure iPos >= LBound(aData)
If iPos < LBound(aData) Then Exit Property
If iPos > UBound(aData) Then
'We need to resize the array
ReDim Preserve aData(iPos)
aData(iPos) = varValue
Else
'We don't need to resize the array
aData(iPos) = varValue
End If
End Property
'****************************************
'************** Methods *****************
Public Function StartIndex()
StartIndex = LBound(aData)
End Function
Public Function StopIndex()
StopIndex = UBound(aData)
End Function
Public Sub Delete(iPos)
'Make sure iPos is within acceptable ranges
If iPos < LBound(aData) Or iPos > UBound(aData) Then
Exit Sub 'Invalid range
End If
Dim iLoop
For iLoop = iPos To UBound(aData) - 1
aData(iLoop) = aData(iLoop + 1)
Next
ReDim Preserve aData(UBound(aData) - 1)
End Sub
'****************************************

[Bob Phillips]

I think a lot more explanation on what this workbook does do, doesn't do, and should do, is required.