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
                
            Else
                
                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.