You can use edit|find to search for the "parts" string in the header. This
would give you the last row that should not be touched.
Then you could delete the ranges (not entire columns anymore) starting with row+1.
Option Explicit
Sub testme()
Dim wks As Worksheet
Dim FoundCell As Range
Dim NextRow As Long
Dim LastRow As Long
Set wks = Worksheets("Sheet1")
With wks
With .Range("a1").EntireColumn
Set FoundCell = .Cells.Find(what:="Parts", _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
End With
If FoundCell Is Nothing Then
MsgBox "Design error: Parts not found in column A"
Exit Sub
End If
NextRow = FoundCell.Row + 1
LastRow = .Rows.Count
.Range(.Cells(NextRow, "I"), .Cells(LastRow, "I")) _
.Delete shift:=xlToLeft
.Range(.Cells(NextRow, "f"), .Cells(LastRow, "F")) _
.Delete shift:=xlToLeft
.Range(.Cells(NextRow, "D"), .Cells(LastRow, "D")) _
.Delete shift:=xlToLeft
.Range(.Cells(NextRow, "B"), .Cells(LastRow, "B")) _
.Delete shift:=xlToLeft
End With
End Sub
The code looks for Parts in column A. If that string isn't found in a cell by
itself, it figures the data is wrong and stops right away.
Then it deletes ranges starting from the right and moving left. I used columns
I, F, D, B. But it was difficult to tell in a plain text message.
You'll want to check the column letters to make sure that they're correct. And
remember to update them in each line twice!!!
