Userform to decide what to do with a text input

High Plains Grifter

Board Regular
Joined
Mar 9, 2010
Messages
129
Hi people, I have written a fairly basic programme (which uses the wonderful fuzzy match by user al_b_cnu) which is a quiz. Various People can write questions in the spreadsheet, and then hide them, and other people can answer the questions, and the results will be saved with their name etc. So far so good. (see code below)

Code:
Sub Quiz()
'number of rounds and questions in total
Dim rounds As Integer
Dim questions As Integer
'current question and round number
Dim qnum As Integer
Dim rnum As Integer
'the number of questions in this round
Dim rq As Integer
'the actual question and answer, as recorded
Dim q As String
Dim a As String
'the answer given by the user
Dim attempt
'the number of questions answered
Dim qdone As Integer
'the number of correct answers
Dim right As Integer
'the name of the current round
Dim title As String
'a written score for the results (correct / answered)
Dim Score As String
'number of passes
Dim pass As Integer
'codename for the quiz
Dim quizname As String
Dim fso
'The name of the saved results file
Dim file As String
'a tester to see whether the quiz has been done before - compares with file
Dim oldname As String
'a number which is used with oldname to scan all scores
Dim i As Integer
'the match score between attempt and answer spelling
Dim spelling As Double
'start at the beginning:
pass = 0
right = 0
qnum = 1
rnum = 0
qdone = 0
rounds = Sheets("Questions").Range("G24")
questions = Sheets("Questions").Range("H24")
'          @@@@@@@@@@@@@@@@@@@@@@@@@@@@
'          @                          @
'          @ The Question Asking Loop @
'          @                          @
'          @@@@@@@@@@@@@@@@@@@@@@@@@@@@
For rnum = 1 To rounds
        rq = Sheets("Questions").Range("H2").Offset(rnum, 0).Value
        title = Sheets("Questions").Range("L2").Offset(rnum, 0).Value
        MsgBox "Round " & rnum & ": " & title, title:="Round Title"
        For qnum = 1 To rq
            q = Sheets("Questions").Range("D1").Offset(qdone, 0).Value
            a = LCase(Sheets("Questions").Range("E1").Offset(qdone, 0).Value)
            attempt = InputBox(q, "Round " & rnum & ", Question " & qnum)
        If attempt = vbNullString Or LCase(attempt) <> a Then
                GoTo wrong
        ElseIf attempt = a Then
                right = right + 1
                GoTo correct
        ElseIf attempt = vbCancel Then Exit Sub
        End If
 
wrong:
            'check whether it is deliberately wrong
        If attempt = "exit" Then
                GoTo exiting
        ElseIf attempt = vbNullString Then
                pass = pass + 1
                Sheets("Results").Range("H3").Offset(qdone, 0).Value = a
                GoTo correct
        End If
            'Define degree of spelling error
            Sheets("Results").Range("M2").Value = attempt
            Sheets("Results").Range("N2").Value = a
            spelling = Sheets("Results").Range("O2").Value
            'check for match rate - use exact match as if specified in the questions sheet
        If Sheets("Questions").Range("P1").Offset(qdone, 0).Value = 1 Then
                Sheets("Results").Range("H3").Offset(qdone, 0).Value = a
        ElseIf attempt = Sheets("Questions").Range("N1").Offset(qdone, 0).Value Then
            If Sheets("Questions").Range("N1").Offset(qdone, 0).Value = NullString Then
                    pass = pass + 1
            Else
                    right = right + 1
                    GoTo correct
            End If
        ElseIf spelling >= 0.35 Then
                'If the match rate is high but not perfect, and the answer is numeric, then it is wrong
            If IsNumeric(a) Then
                    Sheets("Results").Range("H3").Offset(qdone, 0).Value = a
            Else
                    right = right + 1
                    GoTo correct
            End If
                'check whether the spelling error is that "the" has been omitted from the start of the answer
        ElseIf Sheets("Results").Range("O3").Value >= 0.5 Then
                right = right + 1
                GoTo correct
        Else
                Sheets("Results").Range("H3").Offset(qdone, 0).Value = a
        End If
 
correct:
            'Fill in the Results Sheet
            Sheets("Results").Range("A3").Offset(qdone, 0).Value = rnum
            Sheets("Results").Range("D3").Offset(qdone, 0).Value = qnum
            Sheets("Results").Range("E3").Offset(qdone, 0).Value = q
            Sheets("Results").Range("F3").Offset(qdone, 0).Value = attempt
 
            'one more question has been completed!
            qdone = qdone + 1
 
    Next qnum
Next rnum
'          @@@@@@@@@@@@@@@@@@@@@@@@@@@@
'          @                          @
'          @   After the Questions    @
'          @                          @
'          @@@@@@@@@@@@@@@@@@@@@@@@@@@@
 
exiting:
  Score = right & " / " & qdone
  MsgBox "You got " & right & " out of " & qdone, vbInformation, "Results"
  'Display the score on the Results Sheet, with number of passes etc
  Sheets("Results").Range("J3").Value = Score
  Sheets("Results").Range("J9").Value = pass
  Sheets("Results").Visible = True
  Sheets("Quiz").Visible = False
  Sheets("Results").Activate
 
saving:
  'test whether this user has already done this quiz
  quizname = Sheets("Questions").Range("F30").Value _
  & Sheets("Questions").Range("F27").Value & " " & Application.UserName & " " & right
  For i = 0 To questions
        oldname = Sheets("Questions").Range("F30").Value _
        & Sheets("Questions").Range("F27").Value & " " & Application.UserName & " " & i
        file = "P:\ClaimsDocs\Temp - Staff Folders\Shared\" & oldname & ".xls"
        Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(file) Then
            MsgBox "Cheat! You dirty stinking cheat! You can't just go back and try again! Who do you think you are!?", vbInformation, file & " has been located."
            Exit Sub
    End If
  Next i
  file = "P:\ClaimsDocs\Temp - Staff Folders\Shared\" & quizname & ".xls"
  'save the completed results sheet as a new workbook
  Sheets("Results").Select
  Sheets("Results").Copy
  ActiveWorkbook.SaveAs Filename:=file, FileFormat:=56, WriteResPassword:="grifter", ReadOnlyRecommended:=False, _
  CreateBackup:=False
  Sheets("Results").Protect Password:="grifter"
  ActiveWorkbook.Save
  MsgBox "File saved as " & quizname & ".xls", vbInformation, "Quiz Completed - Well Done!"
 
  'Close the original questionnaire, without saving results there too
  ScreenUpdating = False
  Workbooks("Quizm.xls").Close savechanges:=False
  ScreenUpdating = True
End Sub

The trouble is, the inputbox is pretty poor, and I want to use a userform. I have made the userform, which has a frame with the question number, a label with the question, a text entry for the answer and three buttons: Answer, Pass and Exit.

How do I convert the above code so that it can test which of the buttons the user has pressed? Do I have to seperate it all out into different subs, one for Answer_click, one for Pass_click and one for Exit_click? If I do this, how do I maintain the round and question counter?
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top