Monday, 11 August 2014

Code for marking Part 1

Recently I have been working at a company that deals with surveys and report cards for students. So I thought I'd share some of my recent code in case it's useful for anybody else. Please note that this code works with multiple answers that are split with separators such as "|", or single answers.

I also added an option to assign each correct answer a specified mark. If not used, the default mark will be one per correct answer.

Looking at the image below, we can see there are 2 columns. Column A shows a student's answers. Column B shows the correct answers. First I'll just assign each answer of one mark per correct answer. The code knows that total marks should be shown in Column C.

Select the student's answers in Column A and run the "Test" code.

Sub Test()
    Dim rCell As Range
    Dim rRange As Range
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set rRange = Selection
    For Each rCell In rRange.Cells
        Call AddSplitCellValues(rCell, rCell.Offset(, 1), "|")
    Next rCell
    Set rRange = Nothing
End Sub

Sub AddSplitCellValues(rCellMark As Range, rCellCheck As Range, sSeparator As String, Optional varCellScore As Variant)
    Dim tmp As Variant
    Dim tmp2 As Variant
    Dim lCount As Long
    Dim dValue As Double
    On Error Resume Next
    With rCellMark
        tmp = Split(.Text, sSeparator)
        tmp2 = Split(rCellCheck.Text, sSeparator)
        dValue = 0
        For lCount = 0 To UBound(tmp)
            If IsMissing(varCellScore) Then
                dValue = dValue + Abs((tmp(lCount) = tmp2(lCount)))
                .Offset(, 2).Value = dValue
                dValue = dValue + Abs(((tmp(lCount) = tmp2(lCount)) * varCellScore.Value))
                .Offset(, 3).Value = dValue
            End If
        Next lCount
    End With
    On Error GoTo 0
End Sub

Here's the total marks shown.

Let's try that again with marks per answer shown in Column C. The code will show the total marks in Column D.

All I have to do is to change this line in the "Test" code and run it again.

Call AddSplitCellValues(rCell, rCell.Offset(, 1), "|", rCell.Offset(, 2))

See you next time.


  1. Whoa, he's alive! See you in two years! :-)

  2. Maybe sooner.

    New wife, new life :-)

  3. Good idea. Clear and consistent. Thanks for sharing.

  4. You're welcome. Nice site by the way.