#1
|
|||
|
|||
Macro Not Tracking Total Score Correctly
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 |
#2
|
|||
|
|||
Please provide some assistance ...
Please provide some assistance ...
Quote:
|
#3
|
|||
|
|||
The current code is logging the data onto the RECORD sheet like this :
Internxt Drive When it should be logged like this : Internxt Drive |
#4
|
|||
|
|||
try
Code:
Private Sub cmdSubmit_Click() Dim lRow As Integer '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 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 Call get_quiz 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 |
#5
|
|||
|
|||
NoSparks:
Thank you for your assistance. If there are less than the total number of questions that have been accurately answered, the macro is not reflecting such. i.e., If only 8 questions were correctly answered the RECORD sheet still shows 10. ??? |
#6
|
|||
|
|||
Code:
Private Sub cmdSubmit_Click() Dim lRow As Integer '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 lRow = rSH.Range("A" & Rows.Count).End(xlUp).Row + 1 If Mid(btnClicked, 9, 1) = answer Then 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 End If Call get_quiz 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 |
#7
|
|||
|
|||
NoSparks ... thank you. Thank solved the issue.
After one week of staring at the code it all kept looking the same. I wasn't making any progress. Your help is SO GRATEFULLY APPRECIATED !!! |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Total float not calculating correctly | praneetbvb | Project | 0 | 04-30-2020 10:17 AM |
Need to tally check boxes (labeled 1-5) on performance review to get total score based on box value. | Learners Permit | Word | 2 | 07-16-2018 07:56 PM |
Macro functioning correctly | H28Sailor | Excel Programming | 2 | 12-11-2016 03:18 PM |
Ad a quiz with different scores for each question and with final score at the end | Amadeus | PowerPoint | 0 | 09-16-2014 04:24 AM |
How to invoke the macro correctly in the workflow | smndnm | Word VBA | 6 | 07-08-2014 03:13 AM |