Why is this locking up? Loop through all rows, perform function on duplicate, delete duplicate row

Question

The code works when I bite off a couple hundred rows at a time, but always hangs somewhere in the middle when I try to run it on 10,000.

What the code does:

Answer 1

Working with ~10K rows would benefit immensely from a variant array but you can also make significant improvements by deleting all of the rows at once. While you could gather a Union of the rows to delete, a Range.RemoveDuplicates method is also appropriate in this case.

It is unclear on whether your data is sorted on a primary key of column A. Your current code depends upon this but I've changed the criteria check to the Excel Application object's MATCH function to accommodate unsorted data.

Your code appears to avoid text column header labels in row 1. I've used the Range.CurrentRegion property to localize the cells to be processed.

Sub combineDelete()
    Const TEST_COLUMN As String = "A"
    Dim i As Long, mtch As Long

    'appTGGL bTGGL:=False 'uncomment this line once you have completed debugging

    With ActiveSheet
        With .Cells(1, 1).CurrentRegion
            For i = .Rows.Count To 2 Step -1
                mtch = Application.Match(.Cells(i, 1).Value, .Columns(1), 0)
                If mtch < i Then
                    .Cells(mtch, 3) = Application.Sum(.Cells(mtch, 3), .Cells(i, 3))
                    .Cells(mtch, 4) = Application.Sum(.Cells(mtch, 4), .Cells(i, 4))
                    .Cells(mtch, 5) = Application.Sum(.Cells(mtch, 5), .Cells(i, 5))
                End If
            Next i
            .RemoveDuplicates Columns:=1, Header:=xlYes
        End With
    End With

    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
        .StatusBar = vbNullString
    End With
    Debug.Print Timer
End Sub

The use of Application.Sum(..., ...) is a trifle slower than straight addition but it has the benefit of providing error control over text values. This may or may not be a desired behavior; i.e. you might want to know when you are trying to add text to a number instead of skipping over it.

There were many places inside your With ... End With statement where you used Cells(i, 3) and not .Cells(i, 3) (note the prefix . ). If you are going to take the time to reference the Range.Parent property (and you should always do so!) then it seems a shame not to use it.

I've included a reusable 'helper' sub that 'turns off' many application environment states but left it commented. Uncomment it once you havew completed debugging for additional speed and stability.

Addendum for lookup strings with length > 255

Sub combineDelete()
    Dim i As Long, mtch As Long
    Dim vCOLAs As Variant, dCOLAs As Object

    'appTGGL bTGGL:=False 'uncomment this line once you have completed debugging

    Set dCOLAs = CreateObject("Scripting.Dictionary")
    dCOLAs.CompareMode = vbTextCompare

    With ActiveSheet
        With .Cells(1, 1).CurrentRegion
            'strings in column A may exceed 255 chars; build array and and a dictionary from array
            vCOLAs = .Resize(.Rows.Count, 1).Value2
            For i = UBound(vCOLAs, 1) To LBound(vCOLAs, 1) Step -1
                'fast overwrite method
                dCOLAs.Item(vCOLAs(i, 1)) = i
            Next i
            For i = .Rows.Count To 2 Step -1
                mtch = dCOLAs.Item(vCOLAs(i, 1))
                If mtch < i Then
                    .Cells(mtch, 3) = Application.Sum(.Cells(mtch, 3), .Cells(i, 3))
                    .Cells(mtch, 4) = Application.Sum(.Cells(mtch, 4), .Cells(i, 4))
                    .Cells(mtch, 5) = Application.Sum(.Cells(mtch, 5), .Cells(i, 5))
                End If
            Next i
            .RemoveDuplicates Columns:=1, Header:=xlYes
        End With
    End With

    Erase vCOLAs
    dCOLAs.RemoveAll: Set dCOLAs = Nothing

    appTGGL

End Sub

A dictionary object provides lightning fast lookups due to its unique keys. Since these are a variant type, there is no 255 character limit.