Option Explicit 
 
 
Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
    Dim i% 
     
    If Target.Row <> 18 Then Exit Sub 
    Select Case Target.Column 
    Case 2, 3, 5, 6, 8, 9, 11, 12, 14, 15, 17, 18 
         
        If IsNumeric(Target.Value) = False Then 
            Beep 
            MsgBox "Only Numbers between 0 And 10 allowed!" 
            End 
        End If 
         
        If Target.Value > 10 Or Target.Value < 0 Then 
            Beep 
            MsgBox "Only Numbers between 0 And 10 allowed!" 
            End 
        End If 
         
        For i = 11 To 11 - Target.Value + 1 Step -1 
            With Cells(i, Target.Column) 
                If IsEmpty(Target.Offset(0, -1)) Then 
                    .Interior.ColorIndex = 5 
                    .Font.ColorIndex = 3 
                Else 
                    .Interior.ColorIndex = 3 
                    .Font.ColorIndex = 5 
                End If 
            End With 
        Next i 
         
        For i = 11 - Target.Value To 2 Step -1 
            With Cells(i, Target.Column) 
                If IsEmpty(Target.Offset(0, -1)) Then 
                    .Interior.ColorIndex = xlNone 
                    .Font.ColorIndex = 3 
                Else 
                    .Interior.ColorIndex = xlNone 
                    .Font.ColorIndex = 3 
                End If 
            End With 
        Next i 
    End Select 
End Sub