Trivia Question Selector and Printable Document

[NHT93]

Hi everyone,

First time poster here! I found this site to be an amazing resource to help me achieve the first step of my Excel file, but now I have hit a wall as I can't find an answer for what I am looking to do (probably my poor searching/lack of Excel skill!).

Background:
I’m making a three sheet Excel file that I want to make into a trivia question selector that can print out the options selected for trivia.
The first sheet is the category selection. There are 10 Question Categories, each with 3 levels of 'difficulty'. Each question category and difficulty combination has a checkbox (30 checkboxes total) that the person selects if they want to see the recommended 3 questions for that category/difficulty combination.
The second sheet is the Question sheet that has all of the potential trivia questions to choose from (if you're keeping up with the maths, 90 questions all up).
All of the questions start hidden, but when the person clicks the checkboxes on the first sheet, they are then displayed on this page (as such, each question sits in a row, and is fixed to a cell). I have managed to use VBA to code this and it all works fine.

Current Dilemma:
Now for the tricky part! When the person has been presented with the recommended questions to ask (Sheet 2, “Questions”), I want them to be able to select the actual questions they want to ask from the recommendations. Importantly, I want the selections of questions they’ve selected to go onto the final third sheet of the file (Sheet 3, “Printable Document”). As the name implies, I want this to be printable. Firstly, is this possible? What would be the best way to offer selection of recommended questions? And if this is possible, can I give a pre-set format for the questions to fit into?
If it is possible, the format I’d like the questions to go into a unique, individual table that is 2 rows, 5 columns, with top row cells merged.
I’d like each of the questions they select from sheet 2 to fit into their own individual table (so if 10 questions selected, 10 tables in the above format will be printed).

Thanks a million for your help, and please let me know if more information is required!

 

[L. Howard]

You can look at this, which seems to do most of what you want. This is no print stuff, code or such, but I suppose you can construct something for Sheet3 to do your printing.

You have 5 catagories, with 75 questions. In this test setup the questions and answers are clinic chronological data, where you would replace them with actual trivia questions/answers like the example in Sheet1 M1:R1... M = "Male lead actor in Gone With the Wind". N,O,P,Q are the answer choices with one as the correct answer, R is the correct answer. Column R is referred to with formula from Sheet3 where correct answers are marked with a "C".

There are other formulas on the sheet, some are produced by code and others are in-cell formulas here and about.

When you select your choice for the correct answer from J4:J7 that answer and the "Test Taker" name is logged on Sheet3 in the proper category. (There is a clear button on Sheet3 in cell Q1)

You will see the use instructions on Sheet1, and hiding the columns noted in the cell comment (G9) cleans the sheet up quite a bit.

Here is a Drop Box link to my workbook Question Answers ORG.

https://www.dropbox.com/s/c5w5gnyemqsdscl/Question Answer ORG.xlsm?dl=0

Howard


Code in the sheet1 module:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("$J$4:$J$7")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

  ' check to see if answer has been xfered to sheet 3
    If Application.WorksheetFunction.CountA(Range("$J$4:$J$7")) <> 4 Then
    MsgBox "Answer transfered, will exit now!"

    [H4].Activate

    Exit Sub

    End If

    Dim iRet As Long
    Dim strPrompt As String
    Dim strTitle As String
    Dim aCell As Range
    Dim myHdr As String, Nme As String
    Dim hdrRow As Long, hdrCol As Long, LRow As Long
    
    ' Promt
    strPrompt = "You selected: " & vbCr & vbCr & Target.Value & vbCr & vbCr & _
                "As the correct answer." & vbCr & vbCr & """Yes"" then >> Next Question" & vbCr & "Else >> ""No"""
 
    ' Dialog's Title
    strTitle = "My Best Guess Is"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbYesNo, strTitle)
 
 
     ' Check pressed button
    If iRet = vbNo Then
        Exit Sub
    Else
   
 
    myHdr = Sheets("Sheet1").Range("H2")
   
   
On Error GoTo aEnd
        Set aCell = Sheets("Sheet3").Range("B1:N1").Find(What:=myHdr, _
                    LookIn:=xlValues, LookAt:=xlWhole, _
                    MatchCase:=False, SearchFormat:=False)
   
        If Not aCell Is Nothing Then
        
           Nme = Sheets("Sheet1").Range("J1")
           hdrCol = aCell.Column
           hdrRow = Sheets("Sheet3").Cells(Rows.Count, hdrCol).End(xlUp).Row
    
           
           With Target
             .Copy aCell.Offset(hdrRow, 0)
             aCell.Offset(hdrRow, -1) = Nme
             .ClearContents
           End With
           
          ElseIf aCell Is Nothing Then
             MsgBox myHdr & " Not Found"
             Exit Sub
        End If
 
 
    Application.CutCopyMode = False
    [J2] = [J2] + 1
    Range("H4,J4:J7").ClearContents

Exit Sub

aEnd:

MsgBox myHdr & " Not Found"
 
    End If
End Sub

Code in a standard module:

Option Explicit
Sub New_Test()
'// On BLUE shape w/"C"
Dim Data As Range
Dim LRow As Long, aNmeId As Variant, c As Range, ColAP As Range

Set Data = Range("B2:F16,J1")
 Data.Interior.ColorIndex = xlNone
 Sheets("Sheet1").Range("B18:F40, H2, J1, J2, J4:J7, H17").ClearContents

aNmeId = InputBox("Enter your name or ID number")

If aNmeId = "" Then
    Exit Sub

ElseIf IsNumeric(aNmeId) Then
    aNmeId = Val(aNmeId) '/ converts a "text" number to a value

Else

    '/ is text and that is okay

End If

Sheets("Sheet1").Range("J1") = aNmeId

MsgBox "Select a Catagory in cell H2."
[H2].Activate
[H4].ClearContents

End Sub


Sub Next_Test_Question()
'// On orange shape in column H "Next Question"
Dim i As Long
Dim j As Long
Dim k As Variant
Dim l As Long
Dim qNo

    If Application.WorksheetFunction.CountA(Range("$J$4:$J$7")) = 4 Then
        MsgBox "You must transfer your Answer for the question!" _
            & vbCr & vbCr & Range("$I$4") & vbCr & vbCr & _
            "Select the answer you think is correct now."
            
    [J3].Activate
    Exit Sub

    End If

If Cells(2, 8) = "" Then

 MsgBox "You must select a catagory in cell H2!"
 [H2].Activate
 Exit Sub

End If

If Cells(1, 10) = "" Then

 MsgBox "You must have a name in cell J1!"
 [J1].Activate
 Exit Sub

End If


[H4].ClearContents

line1: 'this is where the focus of the code will return _
      'if a number has already been called.  See the "GOTO line1" _
      'in the If statement below

i = Int((5 * Rnd) + 1) 'produces a random number between 1 & 5
'MsgBox I

j = Int((15 * Rnd) + 1) 'produces a random number between 1 & 15
'MsgBox j

'/ limit the number of questions asked in a test session
' counting in cell A4
'/ that number is set on sheet1 cell AT3
If Range("A4").Value = [AT3] Then
  Dim Reply As VbMsgBoxResult
  Dim Data As Range
  
  Reply = MsgBox("All questions have been answered." _
          & vbCr & "Clear and start next test?  Click ""Yes""" _
          & vbCr & "Or clear and Not start new test, Click ""No""", _
          vbYesNo + vbQuestion, "Name the Alert Box here!")
  
  If Reply = vbNo Then
    Set Data = Range("B2:F16,J1")
        Data.Interior.ColorIndex = xlNone
        Sheets("Sheet1").Range("A4,B18:F40, H2, J1, J4:J7, H17").ClearContents
        [H2].Activate
       Exit Sub
  End If
  ' A Yes click
      New_Test
      Exit Sub
 
    
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
        
Range("A1").Offset(j, i).Select '"i" & "j" are now a number between 1 & 5 & _
                                '1 & 15.  So this line will offset from cell A1 _
                                'the number of rows = to "j" and the numbers of _
                                'columns = to "i" and select that cell.
qNo = ActiveCell.Value ' sets "l" to the value of the cell that was just _
                     'selected in the Range("B2:F17")
                     
Range("H4").Value = qNo

'This If statement checks to see if the cell is red.  It it is, then _
'that means it has already been called.  It say to GOTO line1 and the _
'code runs again from "line1" above until it finds a cell that is not _
'red.
If ActiveCell.Interior.ColorIndex = 3 Then
 GoTo line1
End If

MsgBox "Question is: " & vbCr & Range("I4")
       
With Range("J4").Resize(4, 1)
 .Formula = "=VLOOKUP($H$4,$L$2:$AO$76,($AR$2)+ROW()-3,0)": .Value = .Value
End With

ActiveCell.Interior.ColorIndex = 3  'If the selected cell is not red _
                                    'it turns it red here.
If ActiveCell.Column = 2 Then
        Range("B50").End(xlUp).Offset(1, 0) = ActiveCell.Value
    ElseIf ActiveCell.Column = 3 Then
        Range("C50").End(xlUp).Offset(1, 0) = ActiveCell.Value
    ElseIf ActiveCell.Column = 4 Then
        Range("D50").End(xlUp).Offset(1, 0) = ActiveCell.Value
    ElseIf ActiveCell.Column = 5 Then
        Range("E50").End(xlUp).Offset(1, 0) = ActiveCell.Value
    ElseIf ActiveCell.Column = 6 Then
        Range("F50").End(xlUp).Offset(1, 0) = ActiveCell.Value
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub