Private Sub Worksheet_Change(ByVal Target As Range)
With [D4].CurrentRegion
.Interior.ColorIndex = xlNone
On Error Resume Next
With .Columns(Application.Match([A5], .Rows(1), 0))
.Interior.ColorIndex = 6
If Target.Address = "$A$5" Then .Cells(1).Select
End With
End With
End Sub