Union Delete Columns Quickly Producing Error 1004

Question

I want to quickly delete 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 (the table has 708). There should be a little over 100 columns left undeleted.

I copied VBA code found at https://stackoverflow.com/a/75645262.

I get

run-time error code 1004
Delete method of range class failed

on the final delete attempt of Then DelRange.Delete.

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

Other VBA code has given me the same error on that part.

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 to bulk delete once going through all the columns of that row to collect them.

Answer 1

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