Code for marking, Part 2

Last time I showed how to add split cell values, something that may be useful when marking tests, where separators used for multiple answers.

This time I'll show how to highlight where a student's answers are incorrect. Note that the "Test" code is the same as last time, it's just calling a different subroutine (macro) called "ShowCharactersWhereDifferent". There's nothing to prevent you from running the previously shown "AddSplitCellValues" code at the same time. In fact, it may be a good idea. (Note the code works for non-split values like last time too)

Select the student's answers and run the "Test" code (correct answers are in cells to the left)


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 ShowCharactersWhereDifferent(rCell, rCell.Offset(, 1), "|")
        
    Next rCell
    
    Set rRange = Nothing
    
End Sub

Sub ShowCharactersWhereDifferent(rCell1 As Range, rCell2 As Range, sSeparator As String)
    Dim tmp As Variant
    Dim tmp2 As Variant
    Dim lCount As Long
    Dim sTmpString As String
    Dim lStart As Long
    Dim lFinish As Long
    
    On Error Resume Next
    
    With rCell1
        
        .Font.ColorIndex = xlAutomatic
        
        tmp = Split(.Text, sSeparator)
        
        tmp2 = Split(rCell2.Text, sSeparator)
        
        For lCount = 0 To UBound(tmp)
            
            If lCount = 0 Then
                
                lStart = Len(sTmpString) + 1
                
                sTmpString = tmp(lCount)
                
                lFinish = lStart + Len(tmp(lCount)) - 1
                
            Else
                
                lStart = Len(sTmpString) + 2
                
                sTmpString = sTmpString & sSeparator & tmp(lCount)
                
                lFinish = lStart + Len(tmp(lCount))
                
            End If
            
            If tmp(lCount) <> tmp2(lCount) Then
                
                .Characters(Start:=lStart, Length:=Len(tmp(lCount))).Font.ColorIndex = 3
                
            End If
            
        Next lCount
        
    End With
    
    On Error GoTo 0
End Sub



It's quite simple to adjust the code to do something different. Let's say you prefer to make the font bold instead of red.

Change this line
.Font.ColorIndex = xlAutomatic
to
.Font.Bold = False
and this line
.Characters(Start:=lStart, Length:=Len(tmp(lCount))).Font.ColorIndex = 3
to
.Characters(Start:=lStart, Length:=Len(tmp(lCount))).Font.Bold = True


Or how about strikethough?

Change this line
.Font.ColorIndex = xlAutomatic
to
.Font.Strikethrough = False
and this line
.Characters(Start:=lStart, Length:=Len(tmp(lCount))).Font.ColorIndex = 3
to
.Characters(Start:=lStart, Length:=Len(tmp(lCount))).Font.Strikethrough = True


See you next time.