Shorten the Code - Use CASE ?

[captvsharma]

Hello

What would be a smarter way to shorten the below code please ?

Kind regards
Vivek

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "On Site" Then
        Application.EnableEvents = False
        Rows(Target(1).Row).Columns("E:AB").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.499984740745262
            .PatternTintAndShade = 0
        End With
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "Travel Air" Then
        Application.EnableEvents = False
        Rows(Target(1).Row).Columns("E:AB").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.499984740745262
            .PatternTintAndShade = 0
        End With
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "No Work" Then
        Application.EnableEvents = False
        Rows(Target(1).Row).Columns("E:AB").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.499984740745262
            .PatternTintAndShade = 0
        End With
        Application.EnableEvents = True
    End If
    
    If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "Travel Road" Then
        Application.EnableEvents = False
        Rows(Target(1).Row).Columns("E:AB").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Application.EnableEvents = True
    End If
    
       If Not Intersect(Target(1), [D4:D400]) Is Nothing And (Target(1).Text) = "Virtual" Then
        Application.EnableEvents = False
        Rows(Target(1).Row).Columns("E:AB").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        Application.EnableEvents = True
    End If

End Sub