Need help to create a macro

I

Igneshwara reddy

I am trying to build a macro for an answer sheet in such a way that, it
performs the below functions when I click on the “SUBMIT†. The sheet
contains two tabs. Firs tab is questions along with the answer options; like

Question # Answer

1 Yes
2 Yes
3 No
4 No
5 Yes
6 Yes
7 No
8 Yes
9 Yes
10 Yes


It should prompt for the USER ID in the question paper sheet

The answers should be copied to the second tab and have to be pasted in the
sheet (the data will be in columns and it has to be transposed to rows) along
with the user ID


Ex: USERID Answers from 1 – 10

The same sheet will be used by several people and it has to be shared. Each
time the user clicks on submit button, the USER ID and the answers from 1 –
10 have to be passed in a single row in the second tab and then the answers
have to be validated with the master sheet which would be in the third tab.

Note: The number of questions may change from time to time and has to be
compatible to adjust with the numbers.

In two columns, I would name as total marks and Percentage. It should
calculate the score and also the percentage and should show up immediately
after clicking on the SUBMIT button and also have to be stored in the path I
mention it.

Kindly let me know how I can do this.
 
S

stanleydgromjr

Igneshwara reddy,

Please post your workbook - click on *Peply*, then scroll down and se
*Manage Attachments*.
 
B

Billy Liddel

Hello Igneshwara,

I named sheet1 Questions, where the student enters the answers
Sheet2 Summary, where the student answers are copied to
and sheet 3 Master than contains the Q & A.

The following dynamic ranges were created in Name Manager

MasterAnswers =OFFSET(MasterQuestions,0,1)
MasterQuestions =OFFSET(Master!$A$2,0,0,COUNTA(Master!$A:$A)-1)
QAndA =OFFSET(MasterQuestions,0,0,,2)
Student_Ids =OFFSET(Master!$E$2,0,0,COUNTA(Master!$E:$E)-1)
StudentDetails =OFFSET(Student_Ids,0,0,,2)

The code uses the range names so they are important.

The first macro hides the master sheet so that it can not be seen, even by
choosing unhide sheet(s) I assigned a shortcut key to this Ctrl + Shift + T
as this procedure is not visible in the Macro dialog box. If the sheet is
hidden, it becomes visible and vice versa.

The master sheet also incudes a range for Student IDs so that a check can be
made during the submit process. The procedure stops if a student enters an
incorrect Id after prompting the student to try again.

'======================================
Private Sub ToggleHiddenSheet()
' With ActiveWorkbook
With Sheets("Master")

If .Visible = True Then
.Visible = xlVeryHidden
Else
.Visible = True
End If

End With
'End With
End Sub

'Copy the questions to the student sheet (Questions) and hide the sheet
' Place a button on the sheet.

Sub copyQuestions()
Dim rngToCopy As Range
Dim rngDest As Range

Set rngToCopy = Range("MasterQuestions")
Set rngDest = Sheets("Questions").Range("A2")

rngToCopy.Copy rngDest
End Sub


'Update the summary sheet
Sub Submit()
Dim vStudentID As Variant
Dim rngStudentIds As Range
Dim iNQuestions As Integer
Dim iIndex As Integer
Dim vStudentAnswers() As Variant
Dim INumber As Integer
Dim rngMasterAnswers As Range
Dim iStudCount As Integer
Dim rngStdAnswers As Range
Dim iScore As Integer
Dim isMatch As Integer
Dim dPercent As Double
Dim wks As Worksheet
Dim rngToCopy As Range
Dim iSummaryScores As Long

'Get the details
vStudentID = InputBox("Enter your Student Id Number", "Submit Test
Scores", 100, 100)
iNQuestions = Range("A1").CurrentRegion.Rows.Count - 1
iScore = 0
INumber = 1

'set all the ranges
Set rngStudentIds = Range("Student_ids")
Set rngStdAnswers = Range(Cells(2, 2), Cells(iNQuestions + 1, 2))
Set rngMasterAnswers = Range("MasterAnswers")
Set wks = Sheets("summary")
With wks
iSummaryScores = .Range("A1").CurrentRegion.Rows.Count + 1
End With


ReDim Preserve vStudentAnswers(INumber)
vStudentAnswers(INumber) = vStudentID

On Error Resume Next
isMatch = WorksheetFunction.Match(CInt(vStudentID), rngStudentIds, 0)
If IsError(isMatch) Or isMatch = 0 Then
MsgBox "Please try again and enter your correct student id"
Exit Sub
End If

For iIndex = 1 To iNQuestions
INumber = INumber + 1
ReDim Preserve vStudentAnswers(INumber)
vStudentAnswers(INumber) = rngStdAnswers(iIndex)
If rngStdAnswers(iIndex) = rngMasterAnswers(iIndex) Then
iScore = iScore + 1
End If

Next iIndex

'add scores to the array
INumber = INumber + 1
ReDim Preserve vStudentAnswers(INumber)
vStudentAnswers(INumber) = iScore

dPercent = WorksheetFunction.Round(iScore / iNQuestions, 2)
INumber = INumber + 1
ReDim Preserve vStudentAnswers(INumber)
vStudentAnswers(INumber) = dPercent

'copy students details to Summary sheet


With wks
For iIndex = 1 To UBound(vStudentAnswers)
.Cells(iSummaryScores, iIndex) = vStudentAnswers(iIndex)
Next
End With
'Clear old answers from question sheet
Range(Cells(2, 2), Cells(iNQuestions + 1, 2)).ClearContents
End Sub

===========================================
Place a button on the Questions sheet for this code.
As the number of questions will vary then we can't format the last cell as
percentage and this is shown as a decimal figure.

At least this keeps the code in the groups!

If you want me to send the worksheet then e-mail me

(e-mail address removed)

just do the obvious with NOSPAM

HTH
Peter
 
B

Billy Liddel

I forgot to mention the save; i have not done it but you can record a macro
during the save and it will show the path.

The problem is the name, do you want a different name for each exam? Would a
date and name be the way? These are things to consider after setting up the
book.

egards
Peter
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top