excel memory overload after multiple iterations

Hello,

i have a macro which opens a template and a source file, copies the information out of the source file into the template in a formatted way then closes the source file and uses the "saveas" command on the template to save and rename the file.

this then loops, after about 200 iterations it crashes. i have noticed by having the task manager open that the memory creeps up with ever iteration (maybe by about the same amout as the template size (8mb)).

does the saveas command then application.close clear the file from memory? or would it be more likely i have memory leakage within my code?

thanks

Does your macro have any large values assigned to a variable through SET, you have to make sure that they equal NOTHING at the end of your script to release memory.

Set myRange = Range("A1:A1000")
.....
Set myRange = Nothing

here is where i think needs improvement.

does excel hold a file in memory if i use

activeworkbook.saveas .....

then

activeworkbook.close

???

Public Sub DataMine()
Dim ByLocation As String
Dim ByState As String
Dim ByMonth As String
Dim ByDepartment As String
Dim ByFineline As String

On Error GoTo err

Cells.Find(What:="Supplier by Location", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
ByLocation = ActiveCell.Address

Cells.Find(What:="Supplier by State", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
ByState = ActiveCell.Address

Cells.Find(What:="Supplier by Month", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
ByMonth = ActiveCell.Address

Cells.Find(What:="Supplier by Department", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
ByDepartment = ActiveCell.Address

Cells.Find(What:="Supplier by Fineline", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
ByFineline = ActiveCell.Address

''copy by location data
Dim LocationStart As Integer
Dim LocationEnd As Integer
Dim LocationRange As String

Dim StateStart As Integer
Dim StateEnd As Integer
Dim StateRange As String

Dim MonthStart As Integer
Dim MonthEnd As Integer
Dim MonthRange As String

Dim DepartmentStart As Integer
Dim DepartmentEnd As Integer
Dim DepartmentRange As String

Dim FinelineStart As Integer
Dim FinelineEnd As Integer
Dim FinelineRange As String



Range(ByLocation).Activate
ActiveCell.Offset(2, 0).Activate
LocationStart = ActiveCell.Row
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Activate
LocationEnd = ActiveCell.Row
LocationRange = "A" & LocationStart & ":L" & LocationEnd
Range(LocationRange).Select
Selection.Copy
Workbooks(SupplierFile).Activate
Sheets("By Store").Activate
Range("A5").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Sort Key1:=Range("C5"), Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
        Application.CutCopyMode = False
        

Workbooks(CurrentSupplier).Activate


' repeats for other dimensioned data, just too long for this forum...

err:   
If err = 91 Then
ActiveWorkbook.Close (False)
ActiveWorkbook.Close (False)
ActiveCell.Offset(0, 3).Value = "Correct Data not found in file"

ElseIf err = 1004 Then

GoTo Bypass

End If


Bypass:

 ByLocation = vbNullString
 ByState = vbNullString
 ByMonth = vbNullString
 ByDepartment = vbNullString
 ByFineline = vbNullString

 LocationStart = 0
 LocationEnd = 0
 LocationRange = vbNullString

 StateStart = 0
 StateEnd = 0
 StateRange = vbNullString

 MonthStart = 0
 MonthEnd = 0
 MonthRange = vbNullString

 DepartmentStart = 0
 DepartmentEnd = 0
 DepartmentRange = vbNullString

 FinelineStart = 0
 FinelineEnd = 0
 FinelineRange = vbNullString


FormatReport



End Sub


Sub FormatReport()
Sheets("By State By Dept").Activate
Range("A16").Activate
Dim startBlank As Integer
Dim endBlank As Integer
Dim DeleteRows As String
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate

startBlank = ActiveCell.Row
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Activate
endBlank = ActiveCell.Row

DeleteRows = startBlank & ":" & endBlank
Rows(DeleteRows).EntireRow.Select
Selection.Delete Shift:=xlUp

On Error GoTo err


Sheets("By Store").Activate
Range("A5").Activate
If ActiveCell.Offset(1, 0).Value = "" Then
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Rows("1:1").EntireRow.Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Delete Shift:=xlUp
Else
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveCell.Rows("1:1").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
End If

Sheets("By Fineline").Activate
Range("A5").Activate
If ActiveCell.Offset(1, 0).Value = "" Then
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Rows("1:1").EntireRow.Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Delete Shift:=xlUp
Else
   Selection.End(xlDown).Select
   ActiveCell.Offset(1, 0).Select
   ActiveCell.Rows("1:1").EntireRow.Select
   Range(Selection, Selection.End(xlDown)).Select
   Selection.Delete Shift:=xlUp
End If

Sheets("Weeks Distribution").Activate
Range("A6").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Rows("1:1").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
ActiveSheet.Visible = False


Sheets("Range Mgt").Activate
If Range("A3").Value = "" Then

Worksheets("Range Mgt").Activate
Worksheets("Range Mgt").Visible = False

Else
Range("A3").Activate
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Rows("1:1").EntireRow.Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
End If

MPage:

Sheets("Main Page").Activate
Range("C5").Value = RunDate
Range("C3").Value = SupplierName
Range("F3").Value = Now()
FixCharts


err:
'If err = 1004 Then
'Worksheets("Range Mgt").Activate
'Worksheets("Range Mgt").Visible = False
'GoTo MPage
'End If

End Sub

Here is what i found through other posts in Excel Forum.

HTML Code: 

Hope it leads you in the right direction.

Draconi