If Then code advice please for existing working code

[ipbr21054]

Evening,

I am using the code shown below.
I need to add a small piece of come to it if you can advise please.

Basically you type a value in cell B7 & a date is also then entered into cell E7
Ive noticed that should you delete the value in cell B7 the date in cell E7 is still present.

So how or where can we add something like If cell ("B7") = "" Then Cell ("E7") = "" etc etc

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
    End If
    
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[ipbr21054]

Trying to get this to work but keep getting End If Without Block If

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
               [COLOR=#ff0000]If Range("B7") = "" Then Range("E7") = ""[/COLOR]
               End If
               End If
        Next c
    End If
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[NoSparks]

try removing the 3 lines below your red line.

 

[ipbr21054]

Thanks that worked.