Suppose that column headings (labels) are in row no 1 frrm A1 to right
in that case try ths macro (modify if necessary)
confirm if macro does what you want.

Sub test()
Dim del() As Range, rng As Range, j As Integer, k As Integer
Dim add As String
On Error Resume Next
Worksheets("sheet1").Activate
Set rng = Range(Range("A1"), Range("A1").End(xlToRight))

j = WorksheetFunction.CountIf(rng, "delete")
ReDim del(1 To j)
k = 1
Set del(k) = rng.Cells.Find(what:="delete", lookat:=xlWhole)
If del(k) Is Nothing Then Exit Sub
add = del(1).Address
MsgBox del(k).Address
k = k + 1
Do
Set del(k) = rng.Cells.FindNext(after:=del(k - 1))
If del(k) Is Nothing Then GoTo line1
If del(k).Address = add Then GoTo line1
MsgBox del(k).Address
k = k + 1
Loop
line1:
k = 0
For k = j To 1 Step -1
del(k).EntireColumn.Delete
Next k

End Sub