There isn't enough memory to complete this action.

I have been running several files with Macros and now when I am trying to run them, I am getting the error "There isn't enough memory to complete this action".

I am assuming that something is not getting cleared out after / before Macros is ran so is just piling up. Is there anything or code that will clear out the resources so the Macros will not produce this error? I haven't had any issues until this morning. Below are screenshots.

Thanks for any help

[ATTACH]383887[/ATTACH

Error.jpg

It looks line your PC does not have enough RAM and hard disk. Excel has advised you to close-off all other files so as to preserve and save memory. Try to reboot the PC and run excel ONLY.

AB33 - I did that, but still get same error. After reboot I am only at 23% Memory 4.0GB caches

4.4/18.6GB Committed

In use
3.4GB

Available
12.3GB

Ohm! Could you please post the code?

Sub MergeFeeSchedules()
    Dim Sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim startrow As Long
    Dim colCount As Integer 'Column count in tables in the worksheets

Application.EnableCancelKey = xlDisabled


    Dim ws As Worksheet
    Dim i As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    'Delete FeeSched_Merge Sheet If Already Exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("FeeSched_Merge").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    
    'Create FeeSchedule Names on Each Sheet
    Call CreateFeeScheduleNames

    ' Add a new summary worksheet.
    Sheets("Contracts").Select
    Set DestSh = ActiveWorkbook.Worksheets.Add '(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
    DestSh.Name = "FeeSched_Merge"
    
    'Get Column Headers
    On Error GoTo ErrorHandler
    Set Sh = ActiveWorkbook.Worksheets(4)
    colCount = Sh.Cells(1, 255).End(xlToLeft).Column
    'Retreive Headers, no Copy&Paste Needed
    With DestSh.Cells(1, 1).Resize(1, colCount)
        .Value = Sh.Cells(1, 1).Resize(1, colCount).Value
    End With

    ' Fill in the start row.
    startrow = 2

    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    
    For Each Sh In ActiveWorkbook.Worksheets
        If (Sh.Name <> DestSh.Name) And (Sh.Name <> "Instructions") And (Sh.Name <> "Contracts") Then

            ' Find the last row with data on the summary
            ' and source worksheets.
            Last = LastRow(DestSh)
            shLast = LastRow(Sh)

            ' If source worksheet is not empty and if the last
            ' row >= StartRow, copy the range.
            If shLast > 0 And shLast >= startrow Then
                'Set the range that you want to copy
                Set CopyRng = Sh.Range(Sh.Rows(startrow), Sh.Rows(shLast))

               ' Test to see whether there are enough rows in the summary
               ' worksheet to copy all the data.
                If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                   MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                   GoTo ExitTheSub
                End If

                ' This statement copies values and formats.
                CopyRng.Copy
                With DestSh.Cells(Last + 1, "A")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

            End If

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

'Color FeeSched Tab
ActiveSheet.Tab.ColorIndex = 43

'GoBack to Contracts
MsgBox "Fee Schedules have been merged into FeeSched_Merge Tab"
Sheets("Contracts").Select
Exit Sub

'Error Handler
ErrorHandler:
MsgBox "There are no Fee Schedules to merge. Please correct and try again!"
Application.DisplayAlerts = False
Sheets("FeeSched_Merge").Delete
Application.DisplayAlerts = True
Exit Sub

End Sub


Function LastRow(Sh As Worksheet)
    On Error Resume Next
    LastRow = Sh.Cells.Find(what:="*", _
                            After:=Sh.Range("A1"), _
                            lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

Function LastCol(Sh As Worksheet)
    On Error Resume Next
    LastCol = Sh.Cells.Find(what:="*", _
                            After:=Sh.Range("A1"), _
                            lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
    On Error GoTo 0
End Function

The Call CreateFeeScheduleNames will go through each sheet and in column A set each cell in the column, as long as there is data in column B, to the sheet name (this I am finding to take the longest after dissecting everything.

Sub CreateFeeScheduleNames()
    Dim ws As Worksheet
    Dim i As Long

Application.EnableCancelKey = xlDisabled
    
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Contracts" Then
                ws.Activate
                    For i = 2 To ActiveSheet.Range("B2").End(xlDown).Row
                    If Range("B" & i).Value <> "" Then
                       Range("A" & i).Value = ActiveSheet.Name
                    End If
                Next
        End If
    Next ws
End Sub

This is Ron Deburin's code. I do not see why excel crashes when you run the code. Yes, you can improve some lines of the code, but this should not make much difference in speed.
I would suggest this
Remove this line
Application.EnableCancelKey = xlDisabled
and add these two lines.

Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

It know it takes ages to watch the code running, but I will step over the code using F8 to see where the code gets stuck.