Delete unselected columns

[llane23]

I got this code from another question about deleting columns, but instead of deleting the selected columns, I would like to delete every other column if that's possible.

Sub RemoveCols()

Dim ibox As String, arr As Variant, i As Long, col As Variant

ibox = InputBox("Enter column headers to delete separated by commas", "Headers")

If Len(ibox) = 0 Then
Exit Sub
Else
arr = Split(ibox, ",")
For i = LBound(arr) To UBound(arr)
With ActiveSheet
col = Application.Match(Trim(arr(i)), .Rows(1), 0)
If IsNumeric(col) Then
.Columns(col).Delete Shift:=xlToLeft
End If
End With
Next i
End If
End Sub

 

[rollis13]

Assuming that headers start from cell A1, this could be a solution:

Option Explicit
Sub DontRemoveTheseCols()
    Dim ibox   As String, arr As Variant, i As Long
    Dim x      As Long, ToDelete As Boolean, col As Long
    ibox = InputBox("Enter column headers not to delete separated by commas", "Headers")
    If Len(ibox) = 0 Then
        Exit Sub
    Else
        With ActiveSheet
            arr = Split(ibox, ",")
            col = Cells.Find(What:="*", After:=.[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            For x = col To 1 Step -1
                ToDelete = False
                For i = LBound(arr) To UBound(arr)
                    If UCase(Trim(arr(i))) = UCase(Trim(Cells(1, x))) Then
                        ToDelete = True
                    End If
                Next i
                If ToDelete = False Then .Columns(x).Delete Shift:=xlToLeft
            Next x
        End With
    End If
End Sub

 

[llane23]

Thank you. This worked perfectly. I am so grateful.

 

[rollis13]

Thanks for the positive feedback, glad having been of some help.