For Loop not fully cycling in excel VBA [duplicate]

Despite everyone saying “just loop backwards” in this & linked posts, that’s not what you want to do.

It’s going to work, and then your next question will be “how can I speed up this loop”.

The real solution is to stop what you’re doing, and do things differently. Modifying a collection as you’re iterating it is never a good idea.

Start with a helper function that can combine two ranges into one:

Private Function CombineRanges(ByVal source As Range, ByVal toCombine As Range) As Range
    If source Is Nothing Then
        'note: returns Nothing if toCombine is Nothing
        Set CombineRanges = toCombine
    Else
        Set CombineRanges = Union(source, toCombine)
    End If
End Function

Then declare a toDelete range and use this CombineRanges function to build (“select”) a Range while you’re iterating – note that this loop does not modify any cells anywhere:

Dim sheet As Worksheet
' todo: use sheet's codename instead if '2019' is in ThisWorkbook
Set sheet = ActiveWorkbook.Worksheets("2019")

Dim source As Range
' note: qualified .Cells member calls refer to same sheet as .Range call
Set source = sheet.Range(sheet.Cells(2, 1), sheet.Cells(2, lColumn))

Dim toDelete As Range
Dim cell As Range
For Each cell In source
    'note: needed because comparing cell.Value with anything will throw error 13 "type mismatch" if cell contains a worksheet error value.
    'alternatively, use cell.Text.
    If Not IsError(cell.Value) Then
        If Not cell.Value Like "*($'000s)*" _
            And Not cell.Value Like "*Stmt Entry*" _
            And Not cell.Value Like "*TCF*" _
            And Not cell.Value Like "*Subtotal*" _
            And Not cell.Value Like "*Hold*" _
        Then
            Set toDelete = CombineRanges(cell, toDelete)
        End If
    End If
Next

The last, final step is to delete the .EntireColumn of the toDelete range… if it isn’t Nothing at that point:

If Not toDelete Is Nothing Then toDelete.EntireColumn.Delete

Leave a Comment