Repeating Macro gets error after several run throughs

Question

Sample WorkbookI have repeating macros that freeze with an error after running 500 to 600 times through. The number of times I need it to run will change every time but mostly be around 2000 times.Error Notice

Line of code it stops onMaE.png

The entire code is below, multiple macros running after each other and calling others until report completes. It runs fine if it runs less than 500 times.

    Sub Start_New_Report()
'
' Start_New_Report Macro
' Clear Old data and prepare for new lines.
'
    Application.ScreenUpdating = False
    Sheets("Filtered Report").Select
    Range("A2:I1048576").Select
    Selection.ClearContents
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"

    Call Filter_Data

End Sub

Sub Filter_Data()
' Filter raw Syteline data to usable lines

    Worksheets("Filtered Report").Range("B2").Value = _
        Worksheets("PurchaseOrderStatus").Range("A5:E5").Value
    Worksheets("Filtered Report").Range("C2").Value = _
        Worksheets("PurchaseOrderStatus").Range("A6:C6").Value
    Worksheets("Filtered Report").Range("D2").Value = _
        Worksheets("PurchaseOrderStatus").Range("A7:F7").Value
    Worksheets("Filtered Report").Range("E2").Value = _
        Worksheets("PurchaseOrderStatus").Range("J5").Value
    Worksheets("Filtered Report").Range("F2").Value = _
        Worksheets("PurchaseOrderStatus").Range("O7").Value
    Worksheets("Filtered Report").Range("G2").Value = _
        Worksheets("PurchaseOrderStatus").Range("P6:R6").Value
    Worksheets("Filtered Report").Range("H2").Value = _
        Worksheets("PurchaseOrderStatus").Range("P7:T7").Value
    Worksheets("Filtered Report").Range("I2").Value = _
        Worksheets("PurchaseOrderStatus").Range("V7").Value

    Call Clear_Raw_Data

End Sub

 Sub Clear_Raw_Data()
' Clear Raw Data Lines

    Sheets("PurchaseOrderStatus").Select
    Rows("5:7").Delete

    Call Blank_Cells

End Sub

Sub Blank_Cells()
' Check if blank cells exist in current line

    Sheets("Filtered Report").Select
    Range("B2").Select
If IsEmpty(Range("B2").Value) Then
    Call Copy_Up
Else
    Call Blank_Cells_Raw_Data
End If

End Sub

Sub Copy_Up()
'
' Copy Data Up from line below if cells are empty.
'
    Range("B3:D3").Copy Range("B2:D2")

    Call Blank_Cells_Raw_Data

End Sub

Sub Blank_Cells_Raw_Data()

    Sheets("PurchaseOrderStatus").Select
    Range("V5").Select
If IsEmpty(ActiveCell.Value) Then
    Call Finalize_Report
Else
    Call Clear_for_Next_Line
End If

End Sub

Sub Clear_for_Next_Line()
'
' Clear_for_Next_Line Macro
'
' Insert_line Macro
    Sheets("Filtered Report").Select
    Range("2:2").Insert CopyOrigin:=xlFormatFromRightOrBelow

' Create next index number

    Worksheets("Filtered Report").Range("A2").Value = _
        Worksheets("Filtered Report").Range("A3").Value + 1

    Call Filter_Data

End Sub

Sub Finalize_Report()
'
' Finalize_Report Macro
' Finish report and sort the order.
'
    Sheets("Filtered Report").Select
    Range("A1") = "Index"
    Columns("A:I").Sort key1:=Range("A2"), _
      order1:=xlAscending, Header:=xlYes

End Sub

No need to `.Select` anything. You could also benefit from some worksheet variables here for readability. — urdearboy, May 28 '20 at 20:32
For your line that errors out, try `ThisWorkbook.Sheets("PurchaseOrderStatus".Rows("5:7").Delete` instead. A quick reference on avoiding `.Select`: [link](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — barvobot, May 28 '20 at 20:37
Tried your suggestion and got the same error as before. It ran just less than 600 times and gets the error. — Red 5, May 29 '20 at 12:46

barvobot · Accepted Answer · 2020-06-03T19:31:49.710

In essence, I discarded the entire model where separate subroutines were calling each other in sequence and replaced it with a single subroutine that performs all of the functions.

I opted to rewrite the sample code by removing the use of .Select (see link) and defining worksheet variables whenever possible.
One other thing I noticed was in Blank_Cells and Blank_Cells_Raw_Data, I don't think you meant to use IsEmpty there (which checks to see if a variable is initialized; see link), but rather determine if the cell itself is empty. I changed this to If Application.WorksheetFunction.CountA(Range) = 0 in both instances.
In Filter_Data, I noticed you're setting the value of one cell (e.g. B2) to the value of multiple cells (e.g. A5:E5). In testing this just set the first cell to the first value in the range defined (i.e. cell A5). Assuming you didn't mean to do something like Application.WorksheetFunction.Sum(ws2.Range("A5:E5")) (to sum the values in those cells) I just changed these to get the first cell.
I changed Filter_Data and a few other spots to use cell/column references instead of ranges when possible.
In Copy_Up I replaced the .Copy function with actually setting the cells to the values (Copy can get weird sometimes so I avoid using it whenever possible).
Additionally, since .Delete and .Insert both slow down the macro considerably, I used a method that avoids doing either by just checking one group of three rows on 'PurchaseOrderStatus' at a time then moving to the next one, and by writing to the first free row on 'Filtered Report' instead of inserting new rows at the top. This sped the macro up considerably (~35 seconds to less than a second).

Option Explicit

Sub Start_New_Report()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range
Dim newRow As Long, lastRow As Long, x As Long

Set ws1 = ThisWorkbook.Sheets("Filtered Report")
Set ws2 = ThisWorkbook.Sheets("PurchaseOrderStatus")

' Turn screen updating / calculation off for speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' Clear Old data and prepare for new lines.
ws1.Range(ws1.Cells(2, 1), ws1.Cells(10000, 9)).ClearContents
ws1.Cells(2, 1) = 1

' Define last row
lastRow = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row - 2

' Iterate through all groups of 3 rows on PurchaseOrderStatus sheet
For x = 5 To lastRow Step 3

    ' Determine new row to write to
    newRow = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row

    ' Filter raw Syteline data to usable lines
    ws1.Cells(newRow, 2) = ws2.Cells(x, 1)
    ws1.Cells(newRow, 3) = ws2.Cells(x + 1, 1)
    ws1.Cells(newRow, 4) = ws2.Cells(x + 2, 1)
    ws1.Cells(newRow, 5) = ws2.Cells(x, 10)
    ws1.Cells(newRow, 6) = ws2.Cells(x + 2, 15)
    ws1.Cells(newRow, 7) = ws2.Cells(x + 1, 16)
    ws1.Cells(newRow, 8) = ws2.Cells(x + 2, 16)
    ws1.Cells(newRow, 9) = ws2.Cells(x + 2, 22)

    ' Copy Data Up from line below if cells are empty.
    If Application.WorksheetFunction.CountA(ws1.Cells(newRow, 2)) = 0 Then
        ws1.Cells(newRow, 2) = ws1.Cells(newRow - 1, 2)
        ws1.Cells(newRow, 3) = ws1.Cells(newRow - 1, 3)
        ws1.Cells(newRow, 4) = ws1.Cells(newRow - 1, 4)
    End If

    ' Create next index number if not the last row
    If x <> lastRow Then
        ws1.Cells(newRow + 1, 1) = ws1.Cells(newRow, 1).Value + 1
    End If

Next x

' Finish report and sort the order.
ws1.Range(ws1.Columns(1), ws1.Columns(9)).Sort _
    Key1:=ws1.Cells(2, 1), _
    Order1:=xlAscending, _
    Header:=xlYes

' Turn screen updating / calculation back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

You are correct in I used IfEmpty to see if the cell itself was empty in Blank_Cells and Blank_Cells_Raw_Data. The Cells in Filter_Data were left from when I originally recorded the macro, I am not trying to SUM them. I did make the changes you suggested but I still getting the same error. Any other suggestions to help streamline my macros would be appreciated. I have a workbook with dummy data I can share but I didn't see a way to link it when I posted original question. — Red 5, Jun 02 '20 at 12:43
I made some changes to remove some complication-prone methods (`Range`, `.Copy`, etc.), see edits above. If you have a sample file to upload you can use Google Drive or Dropbox to put a link in the original post. — barvobot, Jun 02 '20 at 15:28
I made some of the changes you pointed out and it runs faster but still getting the error. I did add a link in the question above to a sample workbook. I just changed things to keep all info anonymous. Thanks for all your help so far. — Red 5, Jun 02 '20 at 16:08
Well at least it fails faster :) I tried that link and got a 'Sorry, the file you have requested does not exist.' error unfortunately. Do you maybe have to 'share' the file to the public? — barvobot, Jun 02 '20 at 20:39
I fixed the link to the sample workbook. Looks like I had copied the link wrong. — Red 5, Jun 03 '20 at 18:23
That example helped considerably! I think I was able to get this working as intended (see edits above). — barvobot, Jun 03 '20 at 19:32
This is excellent, I ran it with actual data and it runs flawlessly. Thanks for your help @barvobot. I have a lot more to learn about writing macros yet. — Red 5, Jun 03 '20 at 20:19

Repeating Macro gets error after several run throughs

1 Answers1