Code:

```
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim VRange As Range
Set VRange = Range("InputRange")
If Intersect(Target, VRange) Is Nothing Then Exit Sub
Select Case Target.Address
Case "$D$5"
answerCell = "E5"
valuesAreEqual = CompareValues(Target.Value, "electron gun", False)
Case "$D$7"
answerCell = "E7"
valuesAreEqual = CompareValues(Target.Value, "negative", False)
Case "$D$9"
answerCell = "E9"
valuesAreEqual = CompareValues(Target.Value, "phosphor", False)
Case "$D$11"
answerCell = "E11"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$D$17"
answerCell = "E17"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$D$22"
answerCell = "E22"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$D$25"
answerCell = "E25"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$D$30"
answerCell = "E30"
valuesAreEqual = CompareValues(Target.Value, 13, False)
Case "$D$34"
answerCell = "E34"
valuesAreEqual = CompareValues(Target.Value, 44, False)
Case "$B$38"
answerCell = "B39"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$C$38"
answerCell = "C39"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$D$38"
answerCell = "D39"
valuesAreEqual = CompareValues(Target.Value, "", True)
Case "$D$45"
answerCell = "E45"
If Not IsNumeric(Evaluate("=" & Target)) Or Target = "" Then
valuesAreEqual = -1
Else
Target.Value = Evaluate(Range("D45").Value)
valuesAreEqual = CompareValues(Target.Value, 1.706 * 10 ^ 11, False)
End If
Case "$D$52"
answerCell = "E52"
valuesAreEqual = CompareValues(Target.Value, 3.07, False)
End Select
If (valuesAreEqual = 0) Then
Range(answerCell).Value = "Will be graded later."
Target.Interior.ColorIndex = xlNone
ElseIf (valuesAreEqual = 1) Then
Range(answerCell).Value = "Correct!"
Target.Interior.ColorIndex = xlNone
Else
Range(answerCell).Value = "Try Again."
Target.Interior.ColorIndex = 36
Target.Activate
End If
End Sub
Function CompareValues(UserValue, CorrectValue, WillBeGradedLater)
UserValue = LCase(UserValue)
If WillBeGradedLater Then
CompareValues = 0
ElseIf (InStr(UserValue, CorrectValue) <> 0) Then
CompareValues = 1
Else
CompareValues = -1
End If
End Function
```