Loop a Find Function and perform a Delete Column Action Until the Find Function Returns 0

Question

I'm adding functionality to a report where some columns will be output with a cell containing 'Delete Me'.

I'm looking to loop a find function in the macro to find 'Delete Me', then delete the entire column.

At the moment, there will be a maximum of three instances of 'Delete Me', so I'm looping three times.

When there are three instances of 'Delete Me', the below Sub works fine, but when there are fewer than three, I get an error message: "Run-time error '91': Object variable or With block variable not set"

Sub Test()

    Dim i As Integer
    
    For i = 1 to 3

        Cells.Find(What:="Delete Me", After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Selection.EntireColumn.Delete
    
    Next i

End Sub

What I'd like to do is loop until the find function doesn't find a 'Delete Me', then exit the Sub.

Answer 1

Delete Columns Containing a Criteria

• Usually, a combination of Find and FindNext is used in such a case.
• Combining the found cells into a range and then deleting the entire columns of the range in one go will probably also be more efficient.
• Note that xlPart means it will also delete aaa delete me aaa opposed to xlWhole where this wouldn't be deleted.

Option Explicit

Sub DeleteColumns()
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.UsedRange
    
    Dim fCell As Range
    Set fCell = rg.Find(What:="Delete Me", _
        After:=rg.Cells(rg.Rows.Count, rg.Columns.Count), LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    
    Dim drg As Range
    
    If Not fCell Is Nothing Then
        Dim FirstCellAddress As String: FirstCellAddress = fCell.Address
        Do
            ' Combine found cells into the Delete range.
            If drg Is Nothing Then
                Set drg = fCell
            Else
                Set drg = Union(drg, fCell)
            End If
            Set fCell = rg.FindNext(After:=fCell)
        Loop Until fCell.Address = FirstCellAddress
    End If
 
    If drg Is Nothing Then
        MsgBox "Nothing deleted.", vbExclamation
    Else
        drg.EntireColumn.Delete
        MsgBox "Columns deleted.", vbInformation
    End If

End Sub