How to clear memory to prevent memory error?

user_4173227 0
Viewed 86

I have a macro which loops through 12 items in a slicer, copying a large pivot table (~400k rows) and pasting values to a separate sheet each time.

When I do this manually it works. However when the macro runs it gets to the 11th item and it crashes, saying "out of memory".

I tried clearing the value from a variable which may hold a large amount of data (Range1 below).

Is there a way to clear temporary memory? I don't understand how a manual process works but the same thing in a macro produces a memory error.

Sub EIMonthlyHarvest()
Dim CurrentWorkbookName As String
Dim TargetWorkbookName As String
Dim TargetSheetName As String
Dim i As Long
Dim Range1 As Range
Dim Months() As Variant

Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

'Set up target book
CurrentWorkbookName = ActiveWorkbook.Name

Workbooks.Add
TargetWorkbookName = ActiveWorkbook.Name
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "JAN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "FEB"
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "MAR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "APR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "MAY"
Sheets.Add After:=ActiveSheet
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "JUN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "JUL"
Sheets.Add After:=ActiveSheet
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "AUG"
Sheets.Add After:=ActiveSheet
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "SEP"
Sheets.Add After:=ActiveSheet
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "OCT"
Sheets.Add After:=ActiveSheet
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "NOV"
Sheets.Add After:=ActiveSheet
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "DEC"

'Start of month loop
For i = 1 To 12
    
    TargetSheetName = Months(i - 1)
    Windows(CurrentWorkbookName).Activate 
    
    ActiveWorkbook.SlicerCaches("Slicer_modMonth").VisibleSlicerItemsList = _
      Array( _
      "[Query].[modMonth].&[" & i & "]")
        
    'Copy and paste values fast
    Set Range1 = Range("B:M")

    Windows(TargetWorkbookName).Activate
    Sheets(TargetSheetName).Activate
    Range("A1").Resize(Range1.Rows.Count, Range1.Columns.Count).Cells.Value = Range1.Cells.Value
    Set Range1 = Nothing

Next i

End Sub

EDIT:
I found a workaround - saving the TargetWorkbook midway through. This means there will be a buildup of smaller files in a temporary save folder.

Is there a more elegant idea?

Sub EIMonthlyHarvest()
Dim CurrentWorkbookName As String
Dim TargetWorkbookName As String
Dim TargetSheetName As String
Dim i As Long
Dim Range1 As Range
Dim Months() As Variant

Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

'Set up target book
CurrentWorkbookName = ActiveWorkbook.Name

Workbooks.Add
TargetWorkbookName = ActiveWorkbook.Name
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "JAN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "FEB"
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "MAR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "APR"
Sheets.Add After:=ActiveSheet
Sheets("Sheet5").Select
Sheets("Sheet5").Name = "MAY"
Sheets.Add After:=ActiveSheet
Sheets("Sheet6").Select
Sheets("Sheet6").Name = "JUN"
Sheets.Add After:=ActiveSheet
Sheets("Sheet7").Select
Sheets("Sheet7").Name = "JUL"
Sheets.Add After:=ActiveSheet
Sheets("Sheet8").Select
Sheets("Sheet8").Name = "AUG"
Sheets.Add After:=ActiveSheet
Sheets("Sheet9").Select
Sheets("Sheet9").Name = "SEP"
Sheets.Add After:=ActiveSheet
Sheets("Sheet10").Select
Sheets("Sheet10").Name = "OCT"
Sheets.Add After:=ActiveSheet
Sheets("Sheet11").Select
Sheets("Sheet11").Name = "NOV"
Sheets.Add After:=ActiveSheet
Sheets("Sheet12").Select
Sheets("Sheet12").Name = "DEC"
  
'Start of month loop
For i = 1 To 12

    If i = 6 Then
        ActiveWorkbook.Save
    End If
  
    TargetSheetName = Months(i - 1)
    Windows(CurrentWorkbookName).Activate
    
    ActiveWorkbook.SlicerCaches("Slicer_modMonth").VisibleSlicerItemsList = _
        Array( _
        "[Query].[modMonth].&[" & i & "]")
        
    Set Range1 = Range("B:M")

    Windows(TargetWorkbookName).Activate
    Sheets(TargetSheetName).Activate
    Range("A1").Resize(Range1.Rows.Count, Range1.Columns.Count).Cells.Value = Range1.Cells.Value
    Set Range1 = Nothing
    
Next i
  
End Sub
memory vba excel
1 Answers

Try the next adapted code, please:

Sub EIMonthlyHarvest()
 Dim i As Long, lastRow As Long, k As Long
 Dim Range1 As Range, Months() As Variant
 Dim wbAct As Workbook, wbCur As Workbook, sh As Worksheet

 Months = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")

 Set wbCur = ActiveWorkbook
 Set wbAct = Workbooks.Add

 For Each sh In wbAct.Sheets
    sh.Name = Months(k): k = k + 1 'give name to the existing sheets
 Next
 For i = k To UBound(Months)
    wbAct.Sheets.Add(After:=wbAct.Sheets(wbAct.Sheets.count)).Name = Months(i) 'give names to the newly added sheets
 Next i

 For i = 1 To 12
    wbCur.SlicerCaches("Slicer_modMonth").VisibleSlicerItemsList = _
                            Array("[Query].[modMonth].&[" & i & "]")
    lastRow = wbCur.UsedRange.rows.count + wbCur.UsedRange.row 'last row
        
    'Copy and paste values fast
    Set Range1 = wbCur.Range("B1:M" & lastRow) 'the range up to the last row
    'drop the range value
    wbAct.Sheets(Months(i - 1)).Range("A1").Resize(Range1.rows.count, _
                 Range1.Columns.count).cells.Value = Range1.cells.Value
    DoEvents
 Next i
End Sub
user_22333080
Related