CODEWITHSUNDEEP
excelvba
Dfuce
Dfuce

Reputation: 25

How can I remove columns without specific headers?

I am writing a VBA macro for excel to remove columns I don't have specific headers for. I have come close but have run into an odd problem with the way the columns remove.

I am using a simple nested IF. The odd thing is when I run my code it only removes every OTHER column that is not in my list. I have to run the macro 4 or 5 times to get the wanted result. This code is meant to be part of a larger macro and will be for other users as well so getting it to work right the first time is key.

Sub DeleteColumns()
Set MR = Range("A1:W1")
For Each cell In MR
    If cell.Value <> "Cartons" Then
        If cell.Value <> "ShipVia" Then
            If cell.Value <> "Name" Then
                If cell.Value <> "Address" Then
                    If cell.Value <> "City" Then
                        If cell.Value <> "State" Then
                            If cell.Value <> "Zip" Then
                                cell.EntireColumn.Delete
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    Next
End Sub

Upvotes: 2

Views: 834

Answers (2)

user8221156
user8221156

Reputation:

@urdearboy is absolutely correct in his diagnosis of the problem. Here is my solution as a variation on the theme of Select Case which happens to be an approach that is both compact and very descriptive (readable).

Sub DeleteColumns()
    Dim LastCol As Long
    Dim i As Long

    LastCol = ActiveSheet.Range("A1:W1").Cells.Count
    i = 1
    Do
        Select Case ActiveSheet.Cells(1, i)
        Case "Cartons", "ShipVia", "Name", "Address", "City", "State", "Zip"
            i = i + 1 ' this column is to remain; examine the next column
        Case Else
            ActiveSheet.Cells(1, i).EntireColumn.Delete
            LastCol = LastCol - 1 ' as you delete columns the right margin moves in
            ' do not increment "i" because the next column moves in place automatically
        End Select
    Loop Until i > LastCol
End Sub

Hope this helps to illustrate the "mechanics" of column deletion.

To have more efficiency in the code (in light of the above) we need to start from the right so that only one "positional" variable is required:

Sub DeleteColumns()
    Dim i As Long

    i= ActiveSheet.Range("A1:W1").Cells.Count
    Do
        Select Case ActiveSheet.Cells(1, i)
        Case Is <> "Cartons", "ShipVia", "Name", "Address", "City", "State", "Zip"
            ActiveSheet.Cells(1, i).EntireColumn.Delete
        End Select
        i = i - 1 
    Loop While i > 0
End Sub

And, of course, this can be easily generalized for the situations when, for example, the range does not start in column "A", etc.

Upvotes: 0

urdearboy
urdearboy

Reputation: 14580

Your Problem

The issue you are seeing is due to the fact that you are deleting columns inside your loop range. When you delete a column, the range you are looping through shifts and this causes columns to be skipped (consistent with your results). To combat this, you can use the Union method which allows you to delete columns outside of the loop so you will not experience the reported issue. The bottom solution shows how to fix the reported issue if you do decide to delete columns inside the loop.

Select Case

Select Case would be my preferred method. Loop through the range and if the cell is not in listed in the first case, it will be flagged to be deleted in the second case (Case Else).

Once you have looped your headers, delete the columns all at once which means there is no range shift while looping.

Sub DeleteColumns()

Dim iCell As Range, DeleteMe As Range

For Each iCell In Range("A1:W1")
    Select Case iCell
        Case "Cartons", "ShipVia", "Name", "Address", "City", "State", "Zip"
            'Do Nothing
        Case Else
            If Not DeleteMe Is Nothing Then
                Set DeleteMe = Union(DeleteMe, iCell)
            Else
                Set DeleteMe = iCell
            End If
    End Select
Next iCell

If Not DeleteMe Is Nothing Then DeleteMe.EntireColumn.Delete

End Sub

Array

You could also loop through an array. Note that the column loop is going backwards to stop the relevant range from shifting inside the loop (your initial problem). To do this, you will need to drop the For Each loop and switch to the For j = # - # so you can utilize the Step -1 property

Sub Array_Method()

Dim Arr: Arr = Array("Cartons", "ShipVia", "Name", "Address", "City", "State", "Zip")
Dim i As Long, j As Long

For j = 23 To 1 Step -1
    For i = UBound(Arr) To LBound(Arr)
        If Arr(i) = Cells(1, j) Then
            Cells(1, j).EntireColumn.Delete
        End If
    Next i
Next j

End Sub

Upvotes: 4

Related Questions