400+ worksheet loop macro Closed

Question

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!

rizvisa1 · Answer

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 ?

gmasterv · Answer

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

rizvisa1 · Answer

try to ensure that any object you open  like

set .myobject = 

you destroy it like

set myobject = nothing

gmasterv · Answer

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

rizvisa1 · Answer

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

gmasterv · Answer

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

gmasterv · Answer

bump

rizvisa1 · Answer

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

400+ worksheet loop macro

8 responses

Similar discussions

Subscribe To Our Newsletter!