Microsoft Office Forums - View Single Post - [Solved] Macro Not Tracking Total Score Correctly

Logit · 03-26-2023, 08:22 AM

I've been working this challenge for a week without success. Time to get outside help.

Macro records one less correct answer than actually exists. So ... if there are ten correct answers the macro records NINE ... then takes the remainder ( ONE ) and applies it to the next user. If you run the program, selecting all of the correct answers, then look at the RECORD sheet you'll see the NINE and the ONE in Column C.

Your assistance is appreciated. I am open to having the code changed in any manner that will result in a correct result.

Thank you.

Code:

Option Explicit

Private btnClicked As String 'A, B, C, D
Private questionNo As Integer
Private question As String, code As String
Private choiceA, choiceB, choiceC, choiceD As String
Private answer As String

 

Private Sub cmdA_Click()
cmdA.BackColor = &HFF00&
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "Answer: A"""
End Sub

Private Sub cmdB_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HFF00&
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
btnClicked = "Answer: B"""
End Sub

Private Sub cmdC_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HFF00&
cmdD.BackColor = &HC0FFFF
btnClicked = "Answer: C"""
End Sub

Private Sub cmdD_Click()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HFF00&
btnClicked = "Answer: D"""
End Sub

Sub resetButton()
cmdA.BackColor = &HC0FFFF
cmdB.BackColor = &HC0FFFF
cmdC.BackColor = &HC0FFFF
cmdD.BackColor = &HC0FFFF
End Sub

 

Private Sub cmdSubmit_Click()
'Check if user click an option
If cmdA.BackColor = &HFF00& Or cmdB.BackColor = &HFF00& Or _
cmdC.BackColor = &HFF00& Or cmdD.BackColor = &HFF00& Then

'Move to the next question
questionNo = questionNo + 1
Label1.Caption = "Question " & questionNo & " of 10"



If cmdSubmit.Caption = "Submit" Then
Call get_quiz
Dim lRow As Integer
lRow = rSH.Range("A" & Rows.Count).End(xlUp).Row + 1
rSH.Range("C" & lRow).Value = rSH.Range("C" & lRow).Value + 1
'rSH.Range("Y1").Value = frm_score.lblScore
txtSampleCode.Text = rSH.Range("C" & lRow).Value
ElseIf cmdSubmit.Caption = "End Exam" Then

'Save the quiz result to record sheet
lRow = rSH.Range("A" & Rows.Count).End(xlUp).Row + 1
rSH.Range("A" & lRow).Value = username
rSH.Range("B" & lRow).Value = Now


frm_score.lblName = username
frm_score.lblScore = rSH.Range("C" & lRow).Value + 1
frm_score.Show
Unload Me
End If

Else
MsgBox "Please select an answer.", vbExclamation, mTitle
End If
End Sub

Private Sub UserForm_Initialize()
questionNo = 1
Call init_SH
Call get_quiz
End Sub

Sub get_quiz()
Call resetButton
Dim lRow As Integer
lRow = questionNo + 1

question = qSH.Range("A" & lRow).Value

choiceA = qSH.Range("B" & lRow).Value
choiceB = qSH.Range("C" & lRow).Value
choiceC = qSH.Range("D" & lRow).Value
choiceD = qSH.Range("E" & lRow).Value
answer = qSH.Range("F" & lRow).Value

txtQuestion.Value = question
cmdA.Caption = choiceA
cmdB.Caption = choiceB
cmdC.Caption = choiceC
cmdD.Caption = choiceD

If qSH.Range("A" & lRow).Value = "" Then
'Last question
'cmdSubmit.Caption = "End Exam"
Unload Me
'Save the quiz result to record sheet
lRow = rSH.Range("A" & Rows.Count).End(xlUp).Row + 1
rSH.Range("A" & lRow).Value = username
rSH.Range("B" & lRow).Value = Now


frm_score.lblName = username
frm_score.lblScore = rSH.Range("C" & lRow).Value
frm_score.Show
Unload Me

End If
End Sub