Deleting row changes font color advice please

[ipbr21054]

Hi,
I am using this working code shown below,
It works like this.
I complete each cell in my new row.
In cell B7 i enter 17 characters,the 10th character is shown in a red font.
Cell E has a date automatically entered due to this 10th character.

If for any reason i decide to delete row 7 at a later stage, then row 8 now becomes row 7.
Then i notice that the 10th character that was red when it was in row 8 is now black like all the other 16 characters.

I know it has done this because it was originaly applied on a change event code but is there a workaround i can apply that it isnt affected should row 7 get deleted thus when row 8 is then row 7 it stays red.

Many thanks

Private Sub Worksheet_Change(ByVal Target As Range)    Dim c As Range
    
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each c In Target
        If c.Row > 6 And c.Column < 9 And Not IsEmpty(c) Then
            If Not c.HasFormula Then
                c.Value = UCase(c.Value)
            Else
                c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
            End If
        End If
    Next c
    
    If Target.CountLarge > 1000 Then GoTo AllowEvents
    
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        For Each c In Intersect(Target, Range("B:B"))
            If c.Row > 6 Then
                If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
                    MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
                    c.Value = ""
                    c.Select
                    GoTo AllowEvents
                Else
                    c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                End If
            End If
        Next c
               If Range("B7") = "" Then Range("E7") = ""
    End If
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[NoSparks]

insert
Range("B7").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
Immediately before End Sub

 

[ipbr21054]

Thanks very much works fine