vba help to delete the column till values met desired header

Dear Experts


I want vba macro to delete the column values till column found exact values
I have set of mutliple column data in sheet1 i want get result in same sheet with deletion of some existing column heading found in the list of range

start search the string first COMMITED SERVICE if find the value in first row of any header delete previous columns till ORDER RELEASE DATE
2nd search string COMMITED SERVICE START if find the value in first row of any header delete previous column till COMMITED SERVICE
3rd search string COMMITED SERVICE ZONE if find the value in first row of any header delete previous column till COMMITED SERVICE START
4th search string COMMITED SERVICE RATE if find the value in first row of any header delete previous column till COMMITED SERVICE ZONE
5th search string COMMITED SERVICE COUNT if find the value in first row of any header delete previous column till COMMITED SERVICE RATE
last search string COMMITED SERVICE END if if find the value in first row of any header delete previous column till COMMITED SERVICE COUNT

find the attachment in that sheet1 contains rows header in yellow color

where finds the values delete left columns till old values met

in sheet2 is what i expect result by macro

Maybe:

Sub breadwinnerZZz()
Dim i As Long
For i = ActiveSheet.UsedRange.Columns.count To 1 Step -1
    Select Case Cells(1, i).Value
        Case Is = "COMMITED SERVICE END"
            If Cells(1, i - 1) <> "COMMITED SERVICE COUNT" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE COUNT"
            If Cells(1, i - 1) <> "COMMITED SERVICE RATE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE RATE"
            If Cells(1, i - 1) <> "COMMITED SERVICE ZONE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE ZONE"
            If Cells(1, i - 1) <> "COMMITED SERVICE START" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE START"
            If Cells(1, i - 1) <> "COMMITED SERVICE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
            Case Is = "COMMITED SERVICE"
            If Cells(1, i - 1) <> "ORDER RELEASE DATE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
    End Select
Next i
End Sub

Sir Its works Perfectly !!! I want one modification while run this code i want add this action( replace header value only of B1(order release date) as (commitment release date) in your code rest of all remain same....thanks alot sir

Maybe:

Sub breadwinnerZZz()
Dim i As Long
Application.ScreenUpdating = False
For i = ActiveSheet.UsedRange.Columns.count To 1 Step -1
    Select Case Cells(1, i).Value
        Case Is = "COMMITED SERVICE END"
            If Cells(1, i - 1) <> "COMMITED SERVICE COUNT" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE COUNT"
            If Cells(1, i - 1) <> "COMMITED SERVICE RATE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE RATE"
            If Cells(1, i - 1) <> "COMMITED SERVICE ZONE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE ZONE"
            If Cells(1, i - 1) <> "COMMITED SERVICE START" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE START"
            If Cells(1, i - 1) <> "COMMITED SERVICE" Then
                Cells(1, i - 1).EntireColumn.Delete
            End If
        Case Is = "COMMITED SERVICE"
            If Cells(1, i - 1) <> "ORDER RELEASE DATE" Then
                Cells(1, i - 1).EntireColumn.Delete
            Else
                Cells(1, i - 1) = "COMMITMENT RELEASE DATE"
            End If
    End Select
Next i
Application.ScreenUpdating = True
End Sub