Search code examples
excelvbaunion

Excel VBA Union Delete Columns Quickly Producing Error 1004


I've been testing various VBA for quickly deleting columns based on values found in the first row. The row is not part of a table, however, the formula used in the row is based on a table a couple rows lower. There are 709 columns total (the table has 708 in case that matters) and after the code runs, there should be a little over 100 columns left undeleted. I've copied this VBA and when I test run it, I get a run-time error code 1004 (Delete method of range class failed) every time on the final delete attempt of "Then DelRange.Delete". This is the reference link of where I found it https://stackoverflow.com/a/75645262

Has anyone experienced this recently and figured out a solution?

Here's what I have:

Sub Delete_Unneeded_Cols()
    Dim ws As Worksheet
    Dim LCol As Long
    Dim DelRange As Range
    Dim i As Long
    
    '~~> Change as applicable
    Set ws = ActiveSheet
    
    With ws
        LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For i = 1 To LCol
            Select Case .Cells(1, i).Value
            Case "DELETE", False
            Case Else
                If DelRange Is Nothing Then
                    Set DelRange = .Columns(i)
                Else
                    Set DelRange = Union(DelRange, .Columns(i))
                End If
            End Select
        Next i
    End With
    
    If Not DelRange Is Nothing Then DelRange.Delete
End Sub

For a bit more context: Other VBA I've used has given me the same error on that part btw. I expect columns to be deleted based on the cell value of "DELETE" written in the cell from the first row. If the word is found in that row of that column, that column should be added to the union variable in order to bulk delete once going through all the columns of that row to finish collecting them.


Solution

  • If you want to delete columns marked with "DELETE" in the first row and not with empty cells in this row try this variant. It works for me:

    Sub Delete_Unneeded_Cols()
        Dim ws As Worksheet
        Dim LCol As Long
        Dim DelRange As Range
        Dim i As Long
        
        '~~> Change as applicable
        Set ws = ActiveSheet
        
        With ws
            LCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    
            For i = 1 To LCol
                Select Case .Cells(1, i).Value
                Case "DELETE"    ', False means also empty cell
              '  Case Else       ' delete columns marked DELETE 
                    If DelRange Is Nothing Then
                        Set DelRange = .Cells(1, i)  '.Columns(i), 1 cell only
                    Else
                        Set DelRange = Union(DelRange, .Cells(1, i))
                    End If
                End Select
            Next i
        End With
        Dim r As Range
        If Not DelRange Is Nothing Then
        For Each r In DelRange.Areas
            r.EntireColumn.Delete
        Next r
    End Sub