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
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