400+ worksheet loop macro

Closed
Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
First off, thanks Rizvisa for your help previously creating a sucessful macro to loop through all open worksheets in the active workbook. It works perfectly on most spreadsheets but this one is huge and has a couple graphs and after about 60 tabs I'm running into memroy errors.

My thought is to loop through about 50 sheets (the macro copys from another sheet, makes one small change, formats the sheet then moves on) then move those 50 worksheets into a new workbook, save as, then go back and do the next 50 sheets, and save as the next workbook.

Any help regarding how to loop through a set number of times before moving to and saving as a new workbook would be greatly appreciated!!!

THANKS!

8 replies

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
Looping only should not have caused out of memory issue.

Try this just for testing purpose

for each sheet in sheets

debug,print sheet.name

next

This loops thru sheets and prints the sheet name in the intermediate window that you can see in the vbe environment by pressing ctrl + G

What you want can be done, but first the reason of out of memory needs to be narrowed down. Would it be possible to post a sample workbook that would mimic the issue that youencounter ?
I don't think I can create the problem using smaller sample workbooks. I beileve the problem to be caused by the shear size of the workbook and the fact that I'm copying and pasting 2 charts in each of the 400+ worksheets. It was crashing out earlier and through a little research I found the "autoscale font" problem causing a problem first (https://www.mrexcel.com/board/threads/too-many-fonts-in-charts.30325/ . By removing the autoscale from the charts I was able to double the number of tabs before I receive the error but still can't get through more than about 60 or so without the macro stopping. It always stops on the same tab now, and always at the section of the macro where I paste the range from "Master" tab to the next sht in the loop.

I'll try the debug, print sheet.name if you think that will help identify the problem more clearly though.

thank you thank you thank uyou
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
try to ensure that any object you open like

set .myobject =

you destroy it like

set myobject = nothing
not sure what exactly I was trying to do? I created a module

Sub debugo ()

for each sheet in sheets
debug.print sheet.name
next

end sub

I hit Ctrl+g and see the sheets names, but the first sheets it lists starts in the "L's" instead of the "A's"

let me ask another way: How would you make this code only type "100" in the first 3 sheets?

For Each Sht In Sheets

Sht.Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "100"

Next Sht

If I can do that, I can run it fifty times and then save as a new spreadsheet and close it. I think that will work because right now, if I re open the problem spreadsheet after completely shutting Excel down, I can rerun the macro a second time for another 60 sheets until it locks up again...

thanks!!
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
the loop was just to show you that you are not getting out of memory because of loop. you are getting out of memory because what is happening inside the loop.

As for sheet names starting with L. You know sheet by sheet name. But each sheet has a index which in general is like serial number as sheets are created. The for loop, by default sort on that So you can select a sheet like Sheets(5) or sheets("hello")

For you question, add this routine

'################################
Sub sheetLooper(startIndex as string, scanSheet as integer)

Dim idx as integer ' variable for for loop

for idx=startIndex to (startIndex + scansheet -1)

'ensure that we do not try to scan beyond the max sheets
if (idx > sheets.count) then exit sub

sheets(idx).select
Range("A1").Select
ActiveCell.FormulaR1C1 = "100"
next idx

end sub


'################################


THEN CALL THE ROUTINE AS

dim scanSheet as integer ' how many sheets are to be scanned in this call
scansheet = 3 ' 3 sheets are to be scanned

call sheetlooper(1, scansheet) ' WILL WORK ON SHEET 1, 2 AND 3

CALL sheetlooper(4, scansheet) ' WILL WORK ON SHEET 4, 5 AND 6
......


Could you paste your macro ?. I want to see why you are running out of memory
sure thing. Here is my latest try:

Provider_Scorecard_Master3.xls is the master workbook with 1 visible tab called "Dashboard" that has a lot of index/match functions to look up values based on the value in cell "A3".

"Distro" is the other visible tab in Provider_Scorecard_Master3.xls and is a list of about 400 names, starting in cell "A4". Cell D4 is a counter to see how many providers I've looped through, and cell G4 is the total number of loops to go through, i.e. the total number of providers.

The main plan here is to go to the Dashboard tab in Provider_Scorecard_master and copy and past the first provider in the loop (from the tab Distro) into the cell "A3" on the Dashboard tab. This updates all the index/match and vlookup formulas in the Dashboard for that provider.

Then, I copy the whole tab and move it to a new workbook called Scorecard1.xls. Copy and paste values to reduce size and memory. Save Scorecard1.xls and return to Provider_Scorecard_master3.xls to start the loop over again

It works great to begin with, but slowly after 25-30 copies it slows down to where the calculation after the paste takes 5-10 minutes and eventualy fails. The few few providers will calculate in 5-10 seconds.

Sub newtry()
'
' newtry Macro
' Macro recorded 3/26/2010 by gvoss
'

'
Workbooks.Open Filename:= _
"D:\TIM\REPORTS\DISTRIBUTION\CONTROLS\Provider_Scorecard_Master3.xls"

'Delete existing file
'Kill "T:\REPORTS\DISTRIBUTION\SCORECARD\Scorecard.xls"

Dim fso
Dim file As String
file = "T:\REPORTS\DISTRIBUTION\SCORECARD\Scorecard1.xls" ' change to match the file w/Path
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(file) Then
fso.DeleteFile file, True
'Else
'MsgBox file & " does not exist or has already been deleted!" _
', vbExclamation, "File not Found"
End If


Workbooks.Add
ChDir "D:\TIM\REPORTS\DISTRIBUTION\SCORECARD"
ActiveWorkbook.SaveAs Filename:= _
"D:\TIM\REPORTS\DISTRIBUTION\SCORECARD\Scorecard1.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Windows("Provider_Scorecard_Master3.xls").Activate
Sheets("Distro").Select

' G4 is the total number of providers to loop through

For X = 1 To Range("G4") Step 1

'create counter to select next provider in list

myCount = Range("D4").Value + 1
Range("A4").Select
ActiveCell.Offset(myCount, 0).Range("A1").Select
Selection.Copy
Sheets("Dashboard").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Dashboard").Select
Application.CutCopyMode = False
Sheets("Dashboard").Copy Before:=Workbooks("Scorecard1.xls").Sheets(1)
Selection.Copy
Sheets("Dashboard").Select

'update sheet name to match provider name

Sheets("Dashboard").Name = Left(Range("A3").Text, 26)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("Provider_Scorecard_Master3.xls").Activate
Sheets("Distro").Select
Range("D4") = myCount

Next

Application.DisplayAlerts = False
ActiveWindow.Close
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Sheets("Sheet3").Activate
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.Save
Application.DisplayAlerts = True
ActiveWindow.Close


'Set excelApp = GetObject(, "Excel.Application")
'excelApp.Quit

End Sub
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
768
I have seen this line causing memory leakage
Sheets("Dashboard").Copy Before:=Workbooks("Scorecard1.xls").Sheets(1)
Try to see if you can copy the data instead of moving the sheet