5
\$\begingroup\$

My code works, but the problem is that it is taking an increasingly long time to run, with the time required to complete calculations increasing every time I use the macro. I've tried a variety of variations and modifications with the syntax, but as I'm pretty new to VBA, I haven't made a whole lot of progress.

Here's the code I'm running (Note, it is running as a subset, and ScreenUpdate = False):

Public Sub deleteRows()

    Dim lastRow As Long
    Dim rng As Range
    With ActiveSheet
        .AutoFilterMode = False
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
        '~~> Set the range of interest, no need to include the entire data range
            With .Range("B2:F" & lastRow)
                .AutoFilter Field:=2, Criteria1:="=0.000", Operator:=xlFilterValues
                .AutoFilter Field:=5, Criteria1:="=0.000", Operator:=xlFilterValues
            End With
        .Range("B1:F" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
        Rows("1:1").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End With
    MsgBox Format(Time - start, "hh:mm:ss")

End Sub

This code basically removes zero-valued results from the data by deleting an entire row. Initially, it ran in about 12 seconds, but that soon became 55 second, which has progressed into increasing long runtimes, with a 'fast' now being in the 5 minuet range. Below is a spreadsheet with the recorded runtimes and corresponding changes made:

Runtime   Changes
6:30  None
7:50  None
5:37  Manually stepped through code
7:45  Run with .cells instead of .range("B1:B" & lastRow)
5:21  Run with .Range(B:B)  instead of .range("B1:B" & lastRow)
9:20  Run with application.calculation disabled/enabled, range unchanged
5:35  Run with application.enableEvents disabled/enabled, range unchanged
11:08 Run with application.enableEvents disabled/enabled, Range(B:B)
5:12  None
7:57  Run with Alternative code (old code)
5:45  Range changed to .Range(cells(2,2), Cells(lastRow,2)
10:25 Range changed to .Range(cells(2,2), Cells(lastRow,2), Application.Calculation Disabled/enabled
5:34  Range set to rngB  for .delete portion (range assigned to variable)
9:59  Range set as rng("B1:F" & lastRow)
5:58  Changed system settings for Excel to "High Priority", code reverted to original
9:41  Rerun of old code for comparison
9:26  Reun with change in old code criteria to "0.000"
0:10  Moved SpecialCells……..Delete into 2nd With/End With
5:15  Rerun  SpecialCells……..Delete into 2nd With/End With
11:31 Rerun  SpecialCells……..Delete into 2nd With/End With
11:38 Excel restart; Rerun  SpecialCells……..Delete into 2nd With/End With
5:18  Excel restart; Rerun  SpecialCells……..Delete into 2nd With/End With
6:49  Removed 2nd with 'loop'; all data put into first with statement

I did some research online, and it looks like this might be a known issue with Excel when working with large datasets, and as mine is ~51k rows, I can see how this might be the case.

...A macro that required several seconds to complete in an earlier version of Excel may require several minutes to complete in a later version of Excel. Alternatively, if you run a macro a second time, the macro may take twice as long to run as it did the first time.

Source

Is there any way to make this run faster, like it initially did? Why is this happening?

\$\endgroup\$
7
  • \$\begingroup\$ This might be better suited on Stack Overflow. If your problem is due to external factors, reviewing the code won't change much about your situation. \$\endgroup\$
    – Pimgd
    Aug 6, 2014 at 15:02
  • \$\begingroup\$ @ Pimgd I intially posted this question on StackOverflow, but I was recommended to this part of the forum. What kind of external factors would affect the runtime? \$\endgroup\$
    – Redshift
    Aug 6, 2014 at 15:06
  • \$\begingroup\$ The same factors you mentioned! Basically, I'm saying that here we'll review the code, but if you think the problem is related to some bug in excel you might be better off not asking here. If you wish to see if the code itself can be optimized, then let me welcome you to Code Review! \$\endgroup\$
    – Pimgd
    Aug 6, 2014 at 15:19
  • 1
    \$\begingroup\$ Link to the crosspost. \$\endgroup\$
    – RubberDuck
    Aug 6, 2014 at 17:59
  • 1
    \$\begingroup\$ All of my data at this point in the code is static. Just values, no formulas. \$\endgroup\$
    – Redshift
    Aug 6, 2014 at 18:30

1 Answer 1

6
\$\begingroup\$

This won't solve the long run times of your code if the issue is the EntireRow.Delete method. I assume you still want those rows deleted and stackoverflow would be the place to get a workaround or solution.

That being said your code should be reviewed.


Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Never use Select unless you are making some macro to find a range for the user. Use Rows("1:1").Insert .... Making these concatenations should be priority #1 after recording a macro. Also you are not declaring the parent of Rows. ActiveSheet is implicitly the parent but Rows is already nested in a With statment. Just put the period .Rows("1:1")... to make it explicit.


With ActiveSheet

As you said, this is being called as a sub function. If your project grows to include more sheets, assuming ActiveSheet is the sheet you want to manipulate won't be safe. Any Sub not meant to be an outermost Sub should not use ActiveSheet, ActiveBook, ActiveCell, or Selection. Sheets, books, and ranges should be passed as an argument.


This variable isn't being used. Delete it.

Dim rng As Range

You get the last row by going to the bottom of the sheet and iterating up until you find the bottom of your data.

lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row

Instead get the bottom of the range containing data:

lastRow = .UsedRange.Rows.Count

Now there is the general steps that your macro takes. It operates like user interaction, which is usually not the best way to approach it. The steps you take:

  • AutoFilter the range
    • only rows with columns "C" and "F" are visible
  • Delete all visible rows in the range

It makes perfect sense in a user interface side but from a programming side is unnecessarily indirect. Rows to delete are marked by remaining visible and then deleted. What if something else has marked rows as invisible? I would suggest iterating over all rows in the range and deleting those that should be.

Public Sub DeleteRows()
    ' ActiveSheet or Range("B2:F" & lastRow) should be passed
    Dim sheet as Worksheet
    set sheet = ActiveSheet

    Dim lastRow As Long
    lastRow = sheet.UsedRange.Rows.Count

    Dim table as Range        
    set table = sheet.Range("B2:F" & lastRow)

    Dim l as Long
    For l = lastRow to 1 step -1

        If ShouldBeDeleted(table.rows(l)) Then 

            table.rows(l).EntireRow.Delete shift:=xlUp

        End If

    Next l

    ' These should be in the outside Sub
    sheet.Range("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    MsgBox Format(Time - start, "hh:mm:ss")

End Sub
Function ShouldBeDeleted(row_range as Range) as Boolean

    ShouldBeDeleted = (row_range.cells(1, 2) = 0 And row_range.cells(1, 5) = 0)

End Function

Pulling bits out like ShouldBeDeleted might seem verbose but there is a better name for it. There is something special about those rows, and I would rename the function IsX where X describes what those rows are. Also, columns "C" and "F" seem to be special for your worksheet. If they are so, declare them as constants

Const IMPORTANT_COL_1 As String = "C"
Const IMPORTANT_COL_2 As String = "F"

Sorting Optimizations

If sorting the rows of the table is allowed and 0 is the minimum then you could sort the table and only iterate over the rows that you need to delete.

Public Sub DeleteRows(table as Range)

    Dim lastRow As Long
    lastRow = table.Rows.Count

    With table.Parent.Sort

        .SortFields.Clear
        .SortFields.Add key:=table.Range(IMPORTANT_COL_1 & ":" & IMPORTANT_COL_1)
        .SortFields.Add key:=table.Range(IMPORTANT_COL_2 & ":" & IMPORTANT_COL_2)
        .SetRange table
        .Apply

    End With

    Dim botRow as Long
    botRow = 1

    While ShouldBeDeleted(table.rows(botRow))
        botRow = botRow + 1
    Wend

    table.range("1:" & botRow).Delete shift:=xlUP

End Sub
\$\endgroup\$
4
  • \$\begingroup\$ You make a good point, but since OP's main concern is performance, I'm not sure iterating over rows to delete them is a good idea. Otherwise a great review. \$\endgroup\$
    – RubberDuck
    Aug 6, 2014 at 19:13
  • \$\begingroup\$ Yes I can't quite reproduce his performance issue. At 5x10^4 rows I consistently get 6-7 seconds. \$\endgroup\$
    – cheezsteak
    Aug 6, 2014 at 20:16
  • \$\begingroup\$ @ptwales Thanks for all the advice! I'm trying to learn VBA, so I've been using the "Record Macro" option a lot, and then going back and cleaning up the code, which would explain my organization style. Thankfully, David Zemens was able to provide an alternate solution on Stack Overflow. \$\endgroup\$
    – Redshift
    Aug 6, 2014 at 20:20
  • \$\begingroup\$ @Redshift Good to hear a solution. If the rows can be rearranged and 0 is the minimum I would suggest sorting the data by "E" and "F" or the "=E+F" instead of using AutoFilter. And then a Do While to find the length of the range. However Excels sorting commands are rather verbose. \$\endgroup\$
    – cheezsteak
    Aug 6, 2014 at 20:32

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.