All cells in code specified alter cell color apart from one

[ipbr21054]

Afternoon all,
I am using the code shown below to copy the data from HONDA SHEET A17:G17 to HONDA LIST A4:G4
This happens after i make my selection from a drop list down in cell F17

Sub sheettolist()'
' sheettolist Macro
Sheets("HONDA SHEET").Range("A17:G17").Copy
Sheets("HONDA LIST").Range("A4").Insert Shift:=xlDown
Application.CutCopyMode = False
Sheets("HONDA LIST").Range("A4").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
ActiveWorkbook.Save
Sheets("HONDA SHEET").Range("A13").Select
End Sub

On the HONDA LIST worksheet is the code shown below which highlights the rows A4;G4 so its more easier for me to see the data within the cells.

Private Sub SortVinButton_Click()    
    Dim x As Long
    
    Application.ScreenUpdating = False
    
    With Sheets("HONDA LIST")
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        
        .Range("A3:G" & x).Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess
    
    End With
                      
    ActiveWorkbook.Save
    
    Application.ScreenUpdating = True
    Sheets("HONDA LIST").Range("A4").Select
    
End Sub

The above works well apart from the cell F4 on HONDA LIST worksheet doesnt change color where the other cells in Row 4 do.

Do you see an issue as to why or maybe advise an edit to force it to work.

Many thanks.

 

[Fluff]

On the Database, change the change event to this

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        [COLOR=#0000ff]If .Column = 13 Then Exit Sub[/COLOR]
        If .Count = 1 And Not .HasFormula Then
            Application.EnableEvents = False
            .Value = UCase(.Value)
            Application.EnableEvents = True
        End If
    End With
End Sub

In the Honda sheet add the line in blue as shown

                Application.EnableEvents = False
                .Rows(17).Insert Shift:=xlDown
                .Range("A17:G17").Borders.Weight = xlThin
                .Range("G17").Value = Date
                .Range("A17").Value = UCase(.Range("A13").Value)
                .Range("B17").Select
                .Range("A13").ClearContents
                [COLOR=#0000ff].Range("A17").Characters(Start:=10, Length:=1).Font.ColorIndex = 3[/COLOR]
                Application.EnableEvents = True

 

[ipbr21054]

Many thanks for all the input,works well.

Cheers

 

[Fluff]

Glad to help & thanks for the feedback

 

[ipbr21054]

Would you mind taking a look at this please.

Thanks.

https://www.mrexcel.com/forum/excel-questions/1033948-drop-down-list-question.html