VBA Add/Remove Row macros runs progressively slower each time I run them

Question

I have two simple scripts that runs progressively slower each time I run them. One adds a row, another removes a row. Besides that, all that's done is some format copying to ensure the table still looks pretty.

Here's the issue: I found if I add a row, remove it, then save the xlsm, the file size increases. Each time I do this, it seems to increase the runtime to the point where the spreadsheet locks up for a few seconds.

For context: calcCOPbottomRow is a row in the excel spreadsheet.

All other named cells are single cell values.

Here they are:

Sub Add_System()

    Call OptimizeCode_Begin

    'Select bottom row of table and insert a new row
    Range("calcCOPbottomRow").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 3
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum + 1) & ":" & CStr(rowNum + 2)).Select
    ActiveSheet.PasteSpecial Format:=4, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

    Call OptimizeCode_End
End Sub

Sub Remove_System()

    If Range("nSystems") <= 1 Then
        MsgBox "Cannot remove final row of COP Calculator Table"
        Exit Sub
    End If

    Call OptimizeCode_Begin

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 2
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum - 1) & ":" & CStr(rowNum)).Select
    ActiveSheet.PasteSpecial Format:=4, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False

    'Delete system row
    Range("calcCOPbottomRow").Offset(-1, 0).Select
    Selection.Delete Shift:=xlUp

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

    Call OptimizeCode_End

End Sub

Is there something in that code I'm not considering that causes this progressive slowdown? For the record, the OptimizeCode_End and OptimizeCode_Start had no impact on this, but if you're curious they're here:

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xlCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub

Any tips would be appreciated-- I'm pretty new to this stuff.

Thanks!

YOu may want to take a look at [this](L:\Delivery (A-L)\FRR\FRR_PLIAQX_002\144\01_SRC\Orig) — cybernetic.nomad, Dec 05 '18 at 19:13
Right away, I can tell you that you that having `Select`/`Selection`/ in your code will slow you down. You should read [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). Additionally, inserting/deleting rows is very taxing on Excel. — dwirony, Dec 05 '18 at 19:14
Thanks @dwirony. This looks like an example where I can easily avoid doing selection. I will make sure to update the code to reflect that. Adding and removing rows starts only taking ~0.5 seconds but if i do it a few times it takes upwards of 3 seconds. It makes me wonder if it's a memory issue I havent considered or if there's something that's painfully unoptimized in the code. Thanks for the feedback! — Sooji, Dec 05 '18 at 19:20
@Sooji I believe you're overthinking it a bit - It looks like all you're doing is format painting a couple rows, then deleting another. In all honesty, I think it's an overkill to use those subs `OptimizeCode_Begin` and `OptimizeCode_End`. Unless you actually have to turn off events for a `Change` event, I don't think any of that will help too much. — dwirony, Dec 05 '18 at 19:28
@dwirony I agree-- really it was just an attempt to consider every possible option. What's puzzling to me is that it's gotten to the point where the spreadsheet is in it's original state before I added/removed rows yet the file size is nearly double. Could it be that I'm inserting a full row that's causing the issue? — Sooji, Dec 05 '18 at 19:31
@Sooji I'd say the culprit is that you're format painting rows, all the way over to the last column in the workbook. If the font is bold, the cell's interior color is yellow and the font color is red, then you've got a lot of empty cells holding that format for no purpose. — dwirony, Dec 05 '18 at 19:32
@dwirony that's a great point! In fact, I think it's the source of the error. After changing this from what I copy/pasting from the "record macro" function to just a `.PasteSpecial Paste:=xlPasteFormats`, things sped up substantially and my file size doesnt keep increasing in size. Thanks! — Sooji, Dec 05 '18 at 19:46

score 3 · Answer 1 · answered Dec 05 '18 at 20:02

Thanks to @dwirony for the help. The issue was not in the insert/delete row, but rather the paste special that I (stupidly) copied from a record macro function. I simplified the paste and removed all unnecessary "Select" code.

Sub Add_System()

    Application.ScreenUpdating = False

    'Select bottom row of table and insert a new row
    Range("calcCOPbottomRow").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 3
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum + 1) & ":" & CStr(rowNum + 2)).PasteSpecial Paste:=xlPasteFormats

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

End Sub

Sub Remove_System()

    If Range("nSystems") <= 1 Then
        MsgBox "Cannot remove final row of COP Calculator Table"
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Dim formatRange As Range
    Dim rowNum As Long

    'Clean up formatting
    rowNum = Range("calcCOPbottomRow").Row - 2
    Set formatRange = Range(CStr(rowNum) & ":" & CStr(rowNum + 1))
    formatRange.Copy
    Rows(CStr(rowNum - 1) & ":" & CStr(rowNum)).PasteSpecial Paste:=xlPasteFormats

    'Delete system row
    Range("calcCOPbottomRow").Offset(-1, 0).Delete Shift:=xlUp

    'Select new row
    Range("calcCOPTableEnd").Offset(-1, 0).Select

End Sub

VBA Add/Remove Row macros runs progressively slower each time I run them

1 Answers1