Array selection from CheckBoxes

[stirlingmw1]

Morning All

I am still working on my Exam Question back Workbook and hope you can help further. Currently I have a UserForm where the Operator selects the number of Questions they require in the Exam, then the code evenly and randomly selects questions from worksheets detailed as a Array. I am trying to put together a revision UserForm where the Operator selects the topics they would like to revise from a series of CheckBoxes. Currently the code is:

Set wsQuiz = ThisWorkbook.Worksheets("Quiz")
shArr = Array("MW", "OPS", "Seamanship", "Executive", "Signatures", "Divisional", "CBRNDC")
Set Quiz = CreateObject("Scripting.Dictionary"

I have 7 CheckBoxes each names after one of the 7 topics.

Any ideas how I can change this code to accept CheckBoxes as the Array as opposed to the text? I have included the main part of the code that generates the questions below if that helps further.

Private Sub Generate_Click()
Dim wsQuiz As Worksheet, ws As Worksheet
Dim sh, shArr
Dim lr As Long, dlr As Long, n As Long, i As Long, r As Long, cnt As Long, TotalCnt As Long
Dim Quiz, it, arrQuestions()
Dim Rate As String, Class As String, Question As String
Dim NumOfQuestions

Application.ScreenUpdating = False

StartTime.Enabled = True
'==============================================================
'Sets the number of Worksheets to select from
Set wsQuiz = ThisWorkbook.Worksheets("Quiz")
shArr = Array("MW", "OPS", "Seamanship", "Executive", "Signatures", "Divisional", "CBRNDC")
Set Quiz = CreateObject("Scripting.Dictionary")
'==============================================================
'Indicates the Cells to be filtered against
NumOfQuestions = wsQuiz.Range("F1").Value
Rate = wsQuiz.Range("B1").Value
Class = wsQuiz.Range("D1").Value
'==============================================================
'Error messages if filter criteria is omitted
If Not IsNumeric(NumOfQuestions) Then
    MsgBox "The Number of Questions  must be a positive number.", vbCritical, "Invalid Number!"
    Exit Sub
ElseIf NumOfQuestions = 0 Then
    MsgBox "Please add the Number of Questions for the Exam and then try again...", vbCritical, "No. of Questions Not Defined!"
    Exit Sub
ElseIf Rate = vbNullString Or Class = vbNullString Then
    MsgBox "Please select Rate and Class of Unit first and then try again..", vbCritical, "Rate or Class Not Selected!"
    Exit Sub
End If
'==============================================================
'Selects the number of Questions to be generated
NumOfQuestions = Int(wsQuiz.Range("F1").Value)


dlr = wsQuiz.Cells(Rows.Count, 1).End(xlUp).Row
If dlr > 3 Then wsQuiz.Range("A4:F" & dlr).ClearContents
'==============================================================
'Divides the number of questions by the number of tabs, change the last number if more tabs are added as well as inserting the tab above
n = Int(NumOfQuestions / 7)
'==============================================================
'Randomly selects the number of questions requested
For Each sh In shArr
    Set ws = ThisWorkbook.Worksheets(sh)
    cnt = Application.CountIfs(ws.Range("F:F"), Rate, ws.Range("G:G"), Class)
    If cnt < n Then
        MsgBox "There are only " & cnt & " questions for " & Rate & " and " & Class & " on " & sh & " Sheet.", vbExclamation, "Not Enough Questions!"
        Exit Sub
    End If
Next sh

cnt = 0
For Each sh In shArr
    Set ws = ThisWorkbook.Worksheets(sh)
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    cnt = cnt + 1
    Do Until Quiz.Count > (cnt * n) - 1
        r = WorksheetFunction.RandBetween(2, lr)
        If ws.Cells(r, "F") = Rate And ws.Cells(r, "G") = Class Then 'Checks Rate and Ship Class and filters questions
            Question = ws.Cells(r, "A")
            If Not Quiz.exists(Question) Then
                Quiz.Item(Question) = ws.Cells(r, "B") & "^" & ws.Cells(r, "C") & "^" & ws.Cells(r, "D") & "^" & ws.Cells(r, "E")
            End If
        End If
    Loop
Next sh

i = 0
Do Until Quiz.Count > NumOfQuestions - 1
    i = WorksheetFunction.RandBetween(1, 5)
    Set ws = ThisWorkbook.Worksheets(shArr(i - 1))
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    r = WorksheetFunction.RandBetween(2, lr)
    If ws.Cells(r, "F") = Rate And ws.Cells(r, "G") = Class Then
        Question = ws.Cells(r, "A")
        If Not Quiz.exists(Question) Then
            Quiz.Item(Question) = ws.Cells(r, "B") & "^" & ws.Cells(r, "C") & "^" & ws.Cells(r, "D") & "^" & ws.Cells(r, "E")
        End If
    End If
Loop
'==============================================================
'Copies the selected questions, answers, marks and references to Quiz Sheet. If adding more columns increase ReDim No, arrQuestions and ReSize
ReDim arrQuestions(1 To NumOfQuestions, 1 To 9)

i = 0
For Each it In Quiz.keys
   i = i + 1
   arrQuestions(i, 2) = it
   arrQuestions(i, 3) = Split(Quiz.Item(it), "^")(0)
   arrQuestions(i, 4) = Split(Quiz.Item(it), "^")(1)
   arrQuestions(i, 5) = Split(Quiz.Item(it), "^")(2)
   arrQuestions(i, 8) = Split(Quiz.Item(it), "^")(3)
Next it
wsQuiz.Range("A4").Resize(NumOfQuestions, 9).Value = arrQuestions
'==============================================================
'Format Columns once questions have been generated
Range("A3:F3" & dlr).Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter