Need help reducing memory

[Tigger22]

I have code running to potentially create a large number of worksheets. As the code is running, it runs slower after each sheet can can take over 8 hours to run. How can I speed this up? I am not an expert and i am sure this code is not as efficient as it could be. What i am trying to do is copy a template worksheet, rename it using from a list and have all of the new worksheet fall in between the Begin and End tab for calculations.

Public Sub CopyIt()
Dim Counter As Integer
Dim Finalrow As Integer
Dim x As Integer
Dim IngRows As Long
Dim PctDone As Single
Dim Lastsheet As Integer


Application.Calculation = xlManual
Application.ScreenUpdating = False

Sheets("Begin").Visible = True
Sheets("End").Visible = True
Sheets("Data").Visible = True
Sheets("Data").Select
' Determine how many deptids are on Data sheet
IngRows = Range("DeptIDStart").CurrentRegion.Rows.Count
Finalrow = Range("A300").End(xlUp).row
Counter = 1
' Loop through each deptid on the data sheet
For x = 1 To Finalrow
Lastsheet = Sheets.Count
Sheets("Data").Select
DeptName = Range("A" & x).Value
' Make a copy of Begin and move to end
Sheets("Begin").Copy After:=Sheets(Lastsheet)
' rename the sheet and set G3 = to the deptid name
Sheets(Lastsheet + 1).Name = DeptName
Sheets(DeptName).Select
Range("G3").Value = DeptName
Counter = Counter + 1
PctDone = (Counter - 1) / IngRows
With UserForm2
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
Application.CutCopyMode = False
DoEvents
Next x
Unload UserForm2
Application.ScreenUpdating = True
'Sheets("Begin").Copy after:=Sheets(lastsheet)
'Sheets(lastsheet + 1).Name = "New Store 1"


Sheets("End").Move After:=Sheets(Sheets.Count)
Sheets("End").Visible = False
Sheets("Begin").Visible = False
Sheets("Data").Select
Columns("A:B").Select
Selection.ClearContents
Range("Complete") = ("Done")
Sheets("Data").Visible = False
Sheets("Total Branch").Visible = True
Call Calc
MsgBox "Worksheets have been added.", vbInformation + vbOKOnly, "Macro Complete"

Call Menu


End Sub

 

[ask2tsp]

I created 50 departement id's in Data!A1:A50, ran the CopyIt sub. It finished in 2 seconds. To be more realistic I need a description of the Begin sheet. Can you provide that?
Also the code of the Calc sub and please surround it with code tags

[code]your code[/code]

so it looks like

your code

 

[Tigger22]

The Begin sheet is a budget worksheet which is filled with formulas to pull in prior and current year history and allow users to build there budget by accounting period and by account. The sheet takes up A1:X726.

The calc sub is below

Sub Calc()

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
    Application.StatusBar = "Please wait while file is updating..."
    ActiveSheet.Calculate
    Application.StatusBar = False
    Application.ScreenUpdating = True
    
End Sub

 

[ask2tsp]

I loaded Begin sheet with formula's in A6:X726. 50 companies, CopyIt 3 secs, Calc 1 sec. Increased companies to 210, now CopyIt 9 secs, Calc 1 sec. Maybe your formula's are heavy for calculation or contain references to other workbooks?

 

[ask2tsp]

my machine: Cpu Intel core i7 @2.4GHz memory 8Gb

After running the macro exel uses 230 Mb

 

[Tigger22]

Yes the formulas are very heavy and are referencing other tabs. If i run 50 companies, if can take 5 hours. I thought turning off the auto calc would help but it doesn't. I do see that the memory gradually increases as it runs so that is way i thought clearing it after each tab may help.

 

[ask2tsp]

Could you please show a few of those formula's? Maybe we can optimize it.

 

[Tigger22]

I have posted the begin worksheet here: http://www.filedropper.com/begin

 

[ask2tsp]

Tigger22 this is quit overwhelming!

There is one modification that reduces calculation time. On the first dept sheet calculate all the formula's that do not (indirect) refer to G3 and write the value in those cells overwriting the formula. After that use this sheet, not the Begin sheet, for the remaining sheet copies.

My first scan of the Begin sheet gives:
Formula's that do not refer back to G3 are in cel: K1:W1,K3:W3,K4:W4,H5,[Axx:Byy,Gxx:gyy where (xx,yy) is one of )=(12,13),(15,17),(19.23),(25,61)]

hth