Why is macro so effing slow???

Here is the macro I wrote:

Sub RemoveNotAddRows()
    Dim bDelRow As Boolean
    Dim c, r, lastRow As Long
    Dim checkVals(30) As Integer
    Dim begSumCol, endSumCol As Integer
    Dim strTmp As String
    Dim wb As Workbook
    Dim ws As Worksheet

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With

    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Sheet1")
    
    begSumCol = -99
    endSumCol = -99
    
    For c = 1 To 30
        strTmp = Left(ws.Cells(1, c), 4)
        If strTmp <> "Cell" Then
            If begSumCol = -99 Then
                begSumCol = c
            ElseIf Len(strTmp) = 0 Then
                endSumCol = c - 1
                Exit For
            End If
        End If
    Next c

    For c = begSumCol To endSumCol
        checkVals(c) = CInt(ws.Cells(1, c))
    Next c
    
    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    For r = lastRow To 2 Step -1
        bDelRow = False
        For c = begSumCol To endSumCol
            If CInt(ws.Cells(r, c)) <> checkVals(c) Then
                bDelRow = True
                Exit For
            End If
        Next c
        If bDelRow Then
            Rows(r).EntireRow.Delete
        End If
    Next r

    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
    End With
End Sub

Nothing special or fancy. Here's the issue: When I tried running this on a file with 43,352 rows and 7 columns of sums to match, I had to kill Excel after 10+ minutes because there were no results. However, when I manually checked the sums in two columns, and reduced the number of rows to 2170, the macro finished in 10 seconds. Simple match suggest that the original file should have finished in about three and one half minutes, but that didn't happen. Why?

update: I just ran this macro again on a different file with 'only' 12,046 rows. Based on the above math, this should have finished in under one minute, but it dd not finish until almost five minutes had elapsed.

Please post a sample file: see yellow banner at top of the page for instructions.

I don't understand the code: you test for row 1 entries not equal to "Cell" and not blank and then create start/end columns.

In the attached file, no data will be selected

OK. You show a piece of code in Post #1 that does do what you want it to, at least not in the time you think it should take.
But you do not explain what you want to achieve. I guess you want possible helpers to wade through the code and figure out what to do but you should explain in a concise manner what you want it to do.
BTW, I have not gone through the code but for some reason, this caught my eye.

Dim begSumCol, endSumCol As Integer

putting it like that will dimension the first as a variant and the second as an integer. It should be like

Dim begSumCol as integer, endSumCol As Integer

If I remember right, integers are from -32768 to +32768 (you can look that up as well as I could have done). Do you exceed this? Mind you, again, I think it will be automatically converted to longs.
Someone can let us know if they feel like.

to remove the rows that do not add up to the values

What values ?

Your code and supplied file do not reconcile!

Re: "do not add up to the values" What values?
Your example shows 12,000+ rows that all add up to 53.

I took 1minute 47 seconds on my machine, deleting ALL rows!?

I don't follow the logic ......

For r = lastRow To 2 Step -1
        bDelRow = False
        For c = begSumCol To endSumCol
            If CInt(ws.Cells(r, c)) <> checkVals(c) Then
                bDelRow = True
                Exit For
            End If
        Next c
        If bDelRow Then
            Rows(r).EntireRow.Delete
        End If
    Next r

Are you effectively filtering on columns L:R?

If so, it fails as there is not a 5 in column Q

Re: "support my inherent laziness". You put your foot in your mouth with this.
So I'll do it for you what I asked for (explain in a concise manner) in Post #8
If the value in Range("L2") <> value in Range("L1") and
value in Range("M2") <> value in Range("M1") and
value in Range("N2") <> value in Range("N1") and
continue to column R
Then you want to do something.
Now you go one row lower but comparison is to the same row (Cells in row 1)
Then you want to do something.
Now you go one row lower but comparison is to the same row (Cells in row 1)
If this is not correct, you might have to suffer and explain.
BTW, the above should start from the bottom if deletions are to be done.

Comparing rows in L2:R12046 to L1:R1 (~5 sec):

Sub Macro1()
    Dim T0      As Double
    Dim Ref     As Variant
    Dim Sample  As Variant
    
    T0 = Timer
    With Application
        .ScreenUpdating = False
        .StatusBar = ""
    End With
    Ref = Application.Transpose(Range("L1").Resize(, 7).Value)
    Ref = Application.Transpose(Ref)
    Ref = Join(Ref, "")
    Range("L2").Activate
        
    Do
        Sample = Application.Transpose(ActiveCell.Resize(, 7).Value)
        Sample = Application.Transpose(Sample)
        Sample = Join(Sample, "")
        
        If Sample <> Ref Then ActiveCell.Offset(, 7).Value = "X"
        
        ActiveCell.Offset(1).Activate
    Loop While ActiveCell.Value <> ""
    
    If ActiveSheet.AutoFilterMode Then
        ActiveSheet.Range("s:s").AutoFilter
    End If
    Range("S1").AutoFilter
    ActiveSheet.Range("s:s").AutoFilter Field:=19, Criteria1:="X"
    ActiveSheet.UsedRange.SpecialCells(xlVisible).EntireRow.Delete

    With Application
        .StatusBar = Round(Timer - T0, 2) & " seconds"
        .ScreenUpdating = True
    End With
End Sub

Option Explicit

Sub RemoveNotRows()
    Dim bDelRow As Boolean
    Dim c As Long, r As Long, lastRow As Long
    Dim checkVals(30) As Integer
    Dim begSumCol As Long, endSumCol As Integer
    Dim strTmp As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim a
    Dim st As Double
    
    st = Timer


    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With

    Set wb = ActiveWorkbook
    Set ws = wb.Sheets("Sheet1")
    
    begSumCol = -99
    endSumCol = -99
    
     With ws
     
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        a = .Range("A1:AE" & lastRow)                                  ' Assign data to array
    
        For c = 1 To 30
            strTmp = Left(a(1, c), 4)
            If (strTmp <> "Cell") And (Len(strTmp) > 0) Then
                If begSumCol = -99 Then
                    begSumCol = c
                    checkVals(c) = CInt(a(1, c))
                Else
                    endSumCol = c
                    checkVals(c) = CInt(a(1, c))
                End If
            End If
        Next c
    
        For r = 2 To lastRow
            For c = begSumCol To endSumCol
                If CInt(a(r, c)) <> checkVals(c) Then
                    a(r, 31) = "D"                                        ' Set "Delete" flag
                    Exit For
                End If
            Next c
        Next r
     
         On Error Resume Next
           .ShowAllData
         On Error GoTo 0
         
         .Range("A1").Resize(UBound(a, 1), 31) = a                         ' Write array back to sheet
         
         With .Range("A2:AE" & lastRow)
            .AutoFilter Field:=31, Criteria1:="D"    ' Filter on "Delete" flag
             Application.DisplayAlerts = False
            .SpecialCells(xlCellTypeVisible).Delete
            Application.DisplayAlerts = True
         End With
         
         On Error Resume Next
           ws.ShowAllData
         On Error GoTo 0
        
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlAutomatic
    End With
    
    MsgBox Round(Timer - st, 2) & " seconds"
    
End Sub

ProtonLeah time: 1.11 secs: above code 0.19 seconds

@groston: thank you your feedback - glad I was able to help a little.. Look at code from Sintek for superfast performance,

I am finding this so hard to understand...What is OP actually trying to achieve...Anyone?

@John...Your code leaves 1 line remaining...
@protonLeah...Your code deletes everything...

@Sintek: the remaining line is the "header" line.

The reason everything is deleted is because the "filtering" fails on every row. If you put 5 into cells in column O, having filtered on ALL the other columns, you will see these those rows remaining.

As to the purpose, ?????

Still doesn't tell me what OP is actually wanting to achieve...Anyway...Moving on lol

@Sintek
See Post #14.

Originally Posted by jolivanes

@Sintek
See Post #14.

Your understanding not confirmed by OP?
And as the two solutions provided give different results and no confirmation from OP...One can just guess I suppose...

To test my macro, I copied L1:R1 to several rows below - they were not deleted.

Try to use Dictionary and Specialcells to attempt to speed up the code. With 50,000 rows, it runs for 3 seconds

PHP Code: 

Option Explicit
Sub RemoveNotAddRows()
Dim i&, j&, rng, res(), ce As Range, t
Dim dic As Object, key, begC As Range, endC As Range
Set dic = CreateObject("Scripting.dictionary")
t = Timer
For Each ce In Range("A1:AD1")
    If IsNumeric(ce.Value) Then 'search the first cell with value
        Set begC = ce
        Exit For
    End If
Next
Set endC = begC.End(xlToRight).End(xlDown) 'search last cell in row 1, then last row in last column
rng = Range(begC, endC).Value ' store data in an array
For i = 2 To UBound(rng)
    dic.Add i, "" ' paste all row indexes into dictionary
Next
For j = 1 To UBound(rng, 2)
    For i = 2 To UBound(rng)
        If rng(i, j) <> rng(1, j) Then
            If dic.exists(i) Then
                dic.Remove (i) ' if at least 1 cell does not match row 1 then delete
            End If
        End If
    Next
Next
With Range("ZZ2:ZZ" & UBound(rng)) 'use column ZZ to write results, then delete
    .Value = "#N/A" 'write error sign into every rows
    For Each key In dic.keys
        Cells(key, "ZZ").ClearContents ' if row match row 1 then remove to be blank
    Next
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete ' delete all "#N/A" at once
    .ClearContents ' delete column ZZ
End With
MsgBox Timer - t
End Sub 


3 different codes...3 different range references...3 different results...
Are you all using the same file?
Is the object to...
Compare the combined num string combinations of L1:R1 with all below...
Compare the sum of L1:R1 with all below...
Compare all nums in L1:R1 exist in below...

My reading is that each row is checked against L1:R1 (array "CheckVals" )and only rows where ALL values in row match are retained.

Performance problem resolved .....

Tx John...Now I understand...
We all get same results...

Sub J3v16()
Dim Num, NumChk, Data, Tm As Double, Dict As Object, Fnd As Range, i As Long
Set Dict = CreateObject("Scripting.Dictionary")
Tm = Timer
With Range("L1:R" & Cells(Rows.Count, 12).End(xlUp).Row)
    Num = Join(Application.Transpose(Application.Transpose(.Rows(1))), "")
    Dict.Add Num, ""
    Data = .Value
    For i = 2 To UBound(Data)
        NumChk = Data(i, 1) & Data(i, 2) & Data(i, 3) & Data(i, 4) & Data(i, 5) & Data(i, 6) & Data(i, 7)
        '! Above snippet as Join is .20s longer....
        If Not Dict.exists(NumChk) Then Data(i, 7) = ""
    Next i
    .Value = Data
    .Sort .Columns(7), xlAscending, , , , , , xlYes
    Set Fnd = .Columns(7).Find("", , xlValues, xlWhole)
    .Rows(Fnd.Row & ":" & .Rows.Count).Clear
End With
Debug.Print Format(Timer - Tm, "0.00") '! 0.20s
End Sub

This is a little faster...

Sub J3v16()
Dim Num, Data, Temp, Tm As Double
Tm = Timer
With Range("L1:R" & Cells(Rows.Count, 12).End(xlUp).Row).Resize(, 8)
    .Columns(8).Formula = "=L1&M1&N1&O1&P1&Q1&R1"
    Num = Join(Application.Transpose(Application.Transpose(.Cells(1).Resize(, 7))), "")
    Data = Filter(Evaluate("Transpose(If(" & .Columns(8).Address & "=""" & Num & """,row(1:" & .Rows.Count & ")))"), False, 0)
    If UBound(Data) > -1 Then
        Temp = Application.Index(.Value, Application.Transpose(Data), Array(1, 2, 3, 4, 5, 6, 7))
        .Clear
         .Resize(IIf(UBound(Data) = 0, 1, UBound(Temp)), 7) = Temp
    End If
End With
Debug.Print Format(Timer - Tm, "0.00") '! 0.13s
End Sub

@John...Would like to see how these perform on your PC...

@sintek: VERY fast:

0.55 for first code. 0.28 for second on 72K rows!

On my "oldie" such results (for 12046 rows):

1. protonLeah 3.71
2. JohnTopley 1.4
3. bebo 1.265625
(but run-time error 424 (object required) on ".ClearContents ' delete column ZZ")
4a. Sintek_1 0.52
4b. Sintek_2 0.27
(but it returns 1+6=7 rows for "6;12;8;11;16;0;0")
5. Ordinary loops with "If" in RAM 0.15

(but it returns 1+6=7 rows for "6;12;8;11;16;0;0")

Has been amended above...