Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-26-2023, 08:22 AM
Logit Logit is online now Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2007
Expert
Macro Not Tracking Total Score Correctly
 
Join Date: Jan 2017
Posts: 529
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default 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
Attached Files
File Type: xlsm Quiz Example.xlsm (42.3 KB, 3 views)
Reply With Quote
  #2  
Old 03-27-2023, 10:46 AM
Logit Logit is online now Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2007
Expert
Macro Not Tracking Total Score Correctly
 
Join Date: Jan 2017
Posts: 529
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default Please provide some assistance ...

Please provide some assistance ...


Quote:
Originally Posted by logit View Post
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
Reply With Quote
  #3  
Old 03-28-2023, 03:50 AM
Logit Logit is online now Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2007
Expert
Macro Not Tracking Total Score Correctly
 
Join Date: Jan 2017
Posts: 529
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

The current code is logging the data onto the RECORD sheet like this :

Internxt Drive

When it should be logged like this :

Internxt Drive
Reply With Quote
  #4  
Old 03-28-2023, 01:33 PM
NoSparks NoSparks is offline Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2010
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 831
NoSparks is just really niceNoSparks is just really niceNoSparks is just really niceNoSparks is just really niceNoSparks is just really nice
Default

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
Reply With Quote
  #5  
Old 03-28-2023, 02:21 PM
Logit Logit is online now Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2007
Expert
Macro Not Tracking Total Score Correctly
 
Join Date: Jan 2017
Posts: 529
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

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.

???
Reply With Quote
  #6  
Old 03-28-2023, 03:00 PM
NoSparks NoSparks is offline Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2010
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 831
NoSparks is just really niceNoSparks is just really niceNoSparks is just really niceNoSparks is just really niceNoSparks is just really nice
Default

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
Reply With Quote
  #7  
Old 03-28-2023, 03:05 PM
Logit Logit is online now Macro Not Tracking Total Score Correctly Windows 10 Macro Not Tracking Total Score Correctly Office 2007
Expert
Macro Not Tracking Total Score Correctly
 
Join Date: Jan 2017
Posts: 529
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

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 !!!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Total float not calculating correctly praneetbvb Project 0 04-30-2020 10:17 AM
Macro Not Tracking Total Score Correctly 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 Not Tracking Total Score Correctly 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

Other Forums: Access Forums

All times are GMT -7. The time now is 02:14 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft