Deleting Column Based On Header

[Guest]

Its not liking the If C <> "Ralph" Or .Name <> "Irvin" Or C.Name <> "Melvin"
Then
statment. I have change it to and and or but still not working.

 

[Guest]

Try this code instead? I'm not sure what was going on in the previously
provided code, so I just wrote this from scratch. If you have any questions,
just ask.

This goes into a regular code module and you access it using Tools | Macro |
Macros

Sub DeleteMiddleColumn()
'any column that is between the two with the
'defined labels will be deleted.
'only works with 1 column between the two
'so with 'Column 1' | newCol | 'Column 2'
'labels, the 'newCol' column would be deleted
'regardless of how it is labeled.

Const keeperCol1 = "Column 1" ' change to actual label
Const keeperCol2 = "Column 2" ' change to actual label
Dim lastColumn As Long
Dim titleRange As Range
Dim anyTitle As Range

lastColumn = Range("A1").Offset(0, Columns.Count - 1).End(xlToLeft).Column
Set titleRange = Range("A1", Cells(1, lastColumn))
For Each anyTitle In titleRange
If UCase(anyTitle.Value) = UCase(keeperCol1) And _
UCase(anyTitle.Offset(0, 2).Value) = UCase(keeperCol2) Then
anyTitle.Offset(0, 1).EntireColumn.Delete
'alldone, can exit
Exit For
End If
Next
Set titleRange = Nothing

End Sub

 

[Guest]

Like I said, I had not tested it. This one I did test. Just copy it and
paste it, then run it on a test sheet of yours before you use it on your
regular file. By using the And operator it will not delete any of your named
ranges that you specify in the code. These are not just headers, they are
named ranges. I only used the first cell of the column for the test but it
will work if you name the entire column.

Sub hdrdel()
Dim C As Range
lc = Cells(2, Columns.Count).End(xlToLeft).Column
Set myRng = Worksheets(1).Range("A1", Cells(1, lc))
For Each C In myRng
If C <> "Ralph" And C <> "Irvin" And C <> "Melvin" Then
C.EntireColumn.Delete
End If
Next
End Sub

 

[Guest]

The editor here messed up one line of code in mine - and if you copy from
that, you'll get a runtime error. Here's code you should be able to copy and
paste without error:

Sub DeleteMiddleColumn()
'any column that is between the two with the
'defined labels will be deleted.
'only works with 1 column between the two
'so with 'Column 1' | newCol | 'Column 2'
'labels, the 'newCol' column would be deleted
'regardless of how it is labeled.

Const keeperCol1 = "Column 1" ' change to actual label
Const keeperCol2 = "Column 2" ' change to actual label
Dim lastColumn As Long
Dim titleRange As Range
Dim anyTitle As Range

lastColumn = Range("A1").Offset(0, _
Columns.Count - 1).End(xlToLeft).Column
Set titleRange = Range("A1", Cells(1, lastColumn))
For Each anyTitle In titleRange
If UCase(anyTitle.Value) = UCase(keeperCol1) And _
UCase(anyTitle.Offset(0, 2).Value) = UCase(keeperCol2) Then
anyTitle.Offset(0, 1).EntireColumn.Delete
'alldone, can exit
Exit For
End If
Next
Set titleRange = Nothing

End Sub