Repeating Macro gets error after several run throughs - excel

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

Answer 1

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