Private Sub Worksheet_Change(ByVal Target As Range)
'Maths % code
Dim myRng As Range
Dim c As Range
Set myRng = Range("A1:A10")
For Each c In myRng
Application.EnableEvents = False
If IsEmpty(c) Then
c.Value = "Enter Maths %"
c.Font.ColorIndex = 3
Else
c.Font.ColorIndex = 1
End If
If c.Value = "Enter Maths %" Then
c.Font.ColorIndex = 3
End If
Select Case c.Value
Case 0 To 16
c.Offset(, 1).Value = "Well below av"
c.Offset(, 1).Interior.ColorIndex = 3
Case 16 To 30
c.Offset(, 1).Value = "Below average"
c.Offset(, 1).Interior.ColorIndex = 45
Case 30 To 70
c.Offset(, 1).Value = "Average"
c.Offset(, 1).Interior.ColorIndex = 6
Case 70 To 84
c.Offset(, 1).Value = "Above average"
c.Offset(, 1).Interior.ColorIndex = 43
Case 84 To 100
c.Offset(, 1).Value = "Well above av"
c.Offset(, 1).Interior.ColorIndex = 4
Case ""
c.Offset(, 1).Value = ""
c.Offset(, 1).Interior.ColorIndex = xlNone
Case "Enter Maths %"
c.Offset(, 1).Value = ""
c.Offset(, 1).Interior.ColorIndex = xlNone
Application.EnableEvents = True
End Select
Next c
End Sub
Bookmarks