How can I optimize this code in Excel VBA?

Try this out. I'm getting the default color for each row from ColA.

This is all in the worksheet code module:

Option Explicit

Const RW_DATES As Long = 7          'row with headers and dates
Const COL_NAME As Long = 2          'column with person's name
Const COL_START_DATE As Long = 4    'column with start date
Const COL_DATE1 As Long = 6         '1st date on header row
Const NUM_ROWS As Long = 150        'how many rows?


Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim c As Range, rng As Range, rngDates As Range, i As Long
    Dim startDate, endDate, rw As Range, arrDates, rngRowDates As Range
    Dim CheckAll As Boolean, hiliteColor As Long, hiliteName As String
    Dim cName As Range, selName, selColor As Long
    
    
    CheckAll = Target Is Nothing 'called from selection_change?
    
    If Not CheckAll Then
        'Was a cell changed? see if any start/end date cells were changed
        Set rng = Application.Intersect(Target, _
                       Me.Cells(RW_DATES + 1, COL_START_DATE).Resize(NUM_ROWS, 2))
        If rng Is Nothing Then Exit Sub   'nothing to do in this case
    Else
        'called from Selection_change: checking *all* rows
        Set rng = Me.Cells(RW_DATES + 1, COL_START_DATE).Resize(NUM_ROWS)
    End If
    Debug.Print "ran", "checkall=" & CheckAll
    
    'header range with dates
    Set rngDates = Me.Range(Me.Cells(RW_DATES, COL_DATE1), _
                            Me.Cells(RW_DATES, Columns.Count).End(xlToLeft))
    arrDates = rngDates.Value 'read dates to array
    
    Set cName = NameHiliteCell() 'see if there's a hilited name
    If Not cName Is Nothing Then
        selName = cName.Value
        selColor = cName.Interior.Color
    End If
    
    'loop over each changed row
    For Each rw In rng.EntireRow.Rows
        
        Set rngRowDates = rw.Cells(COL_DATE1).Resize(1, rngDates.Columns.Count)
        rngRowDates.Interior.ColorIndex = xlNone 'clear by default
        
        startDate = rw.Cells(COL_START_DATE).Value   'read the dates for this row
        endDate = rw.Cells(COL_START_DATE + 1).Value
        
        'determine what color the bar should be
        If Len(selName) > 0 And selName = rw.Cells(COL_NAME).Value Then
            hiliteColor = selColor
        Else
            hiliteColor = rw.Cells(1).Interior.Color
        End If
        
        If startDate > 0 And endDate > 0 Then
            i = 0
            For Each c In rngRowDates.Cells
                i = i + 1
                If arrDates(1, i) >= startDate And arrDates(1, i) <= endDate Then
                    c.Interior.Color = hiliteColor
                End If
            Next c
        End If
    Next rw
End Sub

'just calls Worksheet_Change; add some delay to reduce frequency of firing
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static lastrun As Date
    If lastrun = 0 Then lastrun = Now
    If Now - lastrun > (1 / 86400) Then
        lastrun = Now
        Worksheet_Change Nothing
    End If
End Sub

'find the first name cell which has any fill and return it
Function NameHiliteCell() As Range
    Dim c As Range
    For Each c In Me.Cells(RW_DATES + 1, COL_NAME).Resize(NUM_ROWS)
        If Not c.Interior.ColorIndex = xlNone Then
            Set NameHiliteCell = c
            Exit Function
        End If
    Next c
End Function

My test range: