Help with 'Out of memory' error

T

tomleitch

Board Regular
Joined
Jan 3, 2012
Messages
189
Hi all,

I have quite a complicated (and probably pretty badly coded) spreadsheet.

Occasionally I get an 'Out of memory' error when saving it...

there's quite a few things going on with it and I have had a bit of a google and a look on here and I think it may be something to do with one of my macros storing large amounts of data and not getting rid of it - but I can't work it out.

Bearing in mind that I am a complete novice to vba and my attempt is a very poor butchering job and tinkering (I know it will have lots of bad practice probably, but it does work for what I want 99% of the time), would someone be kind enough to have a look and see if anything obvious sticks out!

Many thanks,
Tom

Code: 
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success Then
    Application.ScreenUpdating = False
    Sheets("ARCHIVED").Visible = 1
    Sheets("OPS PLANNER").Visible = 1
    Sheets("OPS PLANNER").Activate
    Sheets("COVER").Visible = xlSheetVeryHidden
    Sheets("SETTINGS").Visible = xlSheetVeryHidden
    Sheets("CHANGELOG").Visible = xlSheetVeryHidden
    Application.ScreenUpdating = True
    Sheets("OPS PLANNER").Range("A1").Select
            Me.Saved = True
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim dat As String
Dim lrow As Long
Dim lcol As Long
Dim rngnew As Range

Sheets("SETTINGS").Range("A24") = "0"
Sheets("OPS PLANNER").Activate
Application.Goto Reference:=Range("A5010"), Scroll:=False
Application.Goto Reference:=Range("A1"), Scroll:=True

If Sheets("OPS PLANNER").Range("C:G").EntireColumn.Hidden = True Then Sheets("OPS PLANNER").Range("C:G").EntireColumn.Hidden = False
If Sheets("OPS PLANNER").Range("J:AA").EntireColumn.Hidden = True Then Sheets("OPS PLANNER").Range("J:AA").EntireColumn.Hidden = False
If Sheets("OPS PLANNER").Range("AC:AL").EntireColumn.Hidden = True Then Sheets("OPS PLANNER").Range("AC:AL").EntireColumn.Hidden = False
If Sheets("OPS PLANNER").Range("AN:AR").EntireColumn.Hidden = True Then Sheets("OPS PLANNER").Range("AN:AR").EntireColumn.Hidden = False

'''''''''' Archiving jobs not requiring ops planning
Application.EnableEvents = False
dat = ">=" &  date - 28

With Sheets("OPS PLANNER")
            .AutoFilterMode = False
                With .Range("A9:AT5010")
                     .AutoFilter
                     .AutoFilter Field:=3, Criteria1:="N"
                                         
                End With
End With

lrow = Sheets("OPS PLANNER").Cells(Rows.Count, 1).End(xlUp).Row
lcol = Sheets("OPS PLANNER").Cells(9, Columns.Count).End(xlToLeft).Column
If Range("A9:A5010").SpecialCells(xlCellTypeVisible).Count > 1 Then
MsgBox "Jobs not requiring ops planning have been moved to Archived", , "Auto archive"

Application.EnableEvents = True
Sheets("OPS PLANNER").Range("A10:AT5010").SpecialCells(xlCellTypeVisible).Copy
lrow = Sheets("ARCHIVED").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("ARCHIVED").Range("A" & lrow).Offset(1)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
End With
Application.EnableEvents = False
With Sheets("OPS PLANNER").Range("A10:AT5010").SpecialCells(xlCellTypeVisible)
.SpecialCells(xlCellTypeConstants).ClearContents
End With
End If
Sheets("OPS PLANNER").ShowAllData

Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Clear
Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A10:A5010"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
With ActiveWorkbook.Worksheets("OPS PLANNER").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With

Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Clear
Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Add Key:= _
        Range("G10:G5010"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
With ActiveWorkbook.Worksheets("OPS PLANNER").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With

''''''''''''Archiving jobs >28days + issued

dat = ">=" &  date - 28
With Sheets("OPS PLANNER")
            .AutoFilterMode = False
                With .Range("A9:AT5010")
                     .AutoFilter
                     .AutoFilter Field:=39, Criteria1:=dat
                     
                     .AutoFilter Field:=45, Criteria1:="<>"
                     
                End With
End With

lrow = Sheets("OPS PLANNER").Cells(Rows.Count, 1).End(xlUp).Row
lcol = Sheets("OPS PLANNER").Cells(9, Columns.Count).End(xlToLeft).Column
If Range("A9:A5010").SpecialCells(xlCellTypeVisible).Count > 1 Then
MsgBox "Jobs handed over more than 28 days ago have been moved to Archived", , "Auto archive"

Application.EnableEvents = True
Sheets("OPS PLANNER").Range("A10:AT5010").SpecialCells(xlCellTypeVisible).Copy
lrow = Sheets("ARCHIVED").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("ARCHIVED").Range("A" & lrow).Offset(1)
     .PasteSpecial xlPasteFormats
     .PasteSpecial xlPasteValues
End With
Application.EnableEvents = False
With Sheets("OPS PLANNER").Range("A10:AT5010").SpecialCells(xlCellTypeVisible)
.SpecialCells(xlCellTypeConstants).ClearContents
End With
End If
Sheets("OPS PLANNER").ShowAllData

Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Clear
Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Add Key:= _
        Range("A10:A5010"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
With ActiveWorkbook.Worksheets("OPS PLANNER").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With
Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Clear
Sheets("OPS PLANNER").AutoFilter.Sort.SortFields.Add Key:= _
        Range("G10:G5010"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
With ActiveWorkbook.Worksheets("OPS PLANNER").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
       .Apply
    End With
Application.EnableEvents = True
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Finish:
If Sheets("OPS PLANNER").Range("J:AA").EntireColumn.Hidden = False Then Sheets("OPS PLANNER").Range("J:AA").EntireColumn.Hidden = True
If Sheets("OPS PLANNER").Range("AC:AL").EntireColumn.Hidden = False Then Sheets("OPS PLANNER").Range("AC:AL").EntireColumn.Hidden = True
If Sheets("OPS PLANNER").Range("AN:AR").EntireColumn.Hidden = False Then Sheets("OPS PLANNER").Range("AN:AR").EntireColumn.Hidden = True

Sheets("ARCHIVED").Activate
Sheets("ARCHIVED").Range("A3").Select
Application.ScreenUpdating = False
Sheets("COVER").Visible = 1
Worksheets("COVER").Activate
Sheets("SETTINGS").Visible = xlSheetVeryHidden
Sheets("CHANGELOG").Visible = xlSheetVeryHidden
Sheets("OPS PLANNER").Visible = xlSheetVeryHidden
Sheets("ARCHIVED").Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
tomleitch said:
Hi all,

I have quite a complicated (and probably pretty badly coded) spreadsheet.

Occasionally I get an 'Out of memory' error when saving it...

there's quite a few things going on with it and I have had a bit of a google and a look on here and I think it may be something to do with one of my macros storing large amounts of data and not getting rid of it - but I can't work it out.
Click to expand...
Don't know if it will help, but you can try adding this line after any section that does a copy/paste or a copy/pastespecial to ensure the clipboard is cleared of copied data.
Code: 
Application.CutCopyMode = False
 
Upvote 0
You must log in or register to reply here.

Similar threads

Kristylee0228
  • Question
Populating Cell based on File Name and using a List
Replies
0
Views
192
Kristylee0228
Kristylee0228
J
  • Question
Help with VBA Code to to unlock and lock sheet when using a command a command
Replies
1
Views
138
Jeffrey Mahoney
Jeffrey Mahoney
J
  • Question
Run-time error '91"- bypass and add comment
Replies
3
Views
529
Alex Blakenburg
A
S
  • Solved
Undo is greyed out
Replies
7
Views
524
sspatriots
S
R
  • Solved
How do I extract the data label of a trendline in VBA?
2
Replies
14
Views
928
RockandGrohl
R

Forum statistics

Threads
1,215,232
Messages
6,123,759
Members
449,120
Latest member
Aa2

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top