Not able to get out of loop - its loop within a loop

ndbhatt

New Member
Joined
Nov 18, 2005
Messages
14
I am trying to ddo the following:

Main Workbook has following dataheaders
LoanID SM Region data2

1. First I am get the unique values of each region

2. Then apply auto filter to get only rows for first unique region

3. Create a new workbook

4. Paste the rows from step 2

5. Get the unique values for each SM (now its only within that region)

6. Create worksheets within that workbook by SM

7. Once all the SM's are done save that workbook with Region name.

8. Start with workbook for the next region as in step 1

Continue this till workbooks for all region are created and saved.

I am getting error in the outermost loop.

Please find the code as follows:


=====

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> CreateRegion()

<SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> ThisSheet <SPAN style="color:#00007F">As</SPAN> Worksheet
<SPAN style="color:#00007F">Dim</SPAN> InnerSheet <SPAN style="color:#00007F">As</SPAN> Worksheet
<SPAN style="color:#00007F">Dim</SPAN> Wk <SPAN style="color:#00007F">As</SPAN> Workbook
<SPAN style="color:#00007F">Dim</SPAN> Region <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SM <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">Set</SPAN> ThisSheet = ActiveSheet

<SPAN style="color:#00007F">With</SPAN> ThisSheet
<SPAN style="color:#007F00">'Turn off AutoFilters</SPAN>
.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#007F00">'Filter out all unique Region _
and put them in Column E</SPAN>
.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
.Range("E1"), Unique:=<SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#007F00">'Loop through and filter by all unique Regions _
then create a worbbook named after each Region.</SPAN>
<SPAN style="color:#007F00">'Then copy the data for that Region to it's sheet</SPAN>
<SPAN style="color:#00007F">For</SPAN> i = 2 <SPAN style="color:#00007F">To</SPAN> WorksheetFunction.CountA(.Columns("E:E"))
Region = .Cells(i, 5)

<SPAN style="color:#007F00">'Turn on Autofilter if needed</SPAN>
<SPAN style="color:#00007F">If</SPAN> .AutoFilterMode = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> .Rows(1).AutoFilter

<SPAN style="color:#007F00">'Filter down by Region and copy visible cells _
of columns A:D</SPAN>
.Rows(1).AutoFilter Field:=3, Criteria1:=Region
.Columns("A:D").SpecialCells(xlVisible).Copy

<SPAN style="color:#007F00">'Adding new workbook for each region</SPAN>

<SPAN style="color:#00007F">Set</SPAN> Wk = Workbooks.Add
Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#007F00">'Paste new region level data dump on sheet</SPAN>
ActiveSheet.Paste

<SPAN style="color:#007F00">'New Region level data manipulation starts in workbook</SPAN>

<SPAN style="color:#00007F">With</SPAN> ThisWorkbook.ActiveSheet
<SPAN style="color:#007F00">'Turn off AutoFilters</SPAN>
.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#007F00">'Filter out all unique Sales Managers _
and put them in Column E</SPAN>
.Columns(2).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
.Range("F1"), Unique:=<SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#007F00">'Loop through and filter by all unique Sales Manager _
then create a worksheet named after each Sales Manager.</SPAN>
<SPAN style="color:#007F00">'Then copy the data for that Sales Manager to it's sheet</SPAN>
    <SPAN style="color:#00007F">For</SPAN> j = 2 <SPAN style="color:#00007F">To</SPAN> WorksheetFunction.CountA(.Columns("E:E"))
        SM = .Cells(i, 5)
        
            <SPAN style="color:#007F00">'Turn on Autofilter if needed</SPAN>
            <SPAN style="color:#00007F">If</SPAN> .AutoFilterMode = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> .Rows(1).AutoFilter
            
            <SPAN style="color:#007F00">'Filter down by Sales Manager and copy visible cells _
            of columns A:D</SPAN>
            .Rows(1).AutoFilter Field:=2, Criteria1:=SM
            .Columns("A:D").SpecialCells(xlVisible).Copy
        
        
            <SPAN style="color:#007F00">'Add a sheet named after SM</SPAN>
            Sheets.Add().Name = SM
            
            <SPAN style="color:#007F00">'Paste new data on sheet</SPAN>
            ActiveSheet.Paste

   <SPAN style="color:#00007F">Next</SPAN> j
  
    Wk.SaveAs Filename:="C:/" & Region
    ActiveWorkbook.Close <SPAN style="color:#00007F">True</SPAN>
      <SPAN style="color:#007F00">'Here is here I get error (at Next i) - Compile Error: <SPAN style="color:#00007F">Next</SPAN> without for</SPAN>
Next i

.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">Set</SPAN> ThisSheet = <SPAN style="color:#00007F">Nothing</SPAN>
Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>=====

I hope someone can get this working.

Thanks in advance.

- Nick
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
You're missing an "End With" in there somewhere. You've got two "With"'s and only one "End With".
 
Upvote 0
Done with missing "End With" but newer problem cro

First of all thanks to Tazguy for picking up missing code. I have fixed it but now it seems that still there is some problem. I have commented in the inner loop about the problem.

====

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> CreateRegion()

<SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> ThisSheet <SPAN style="color:#00007F">As</SPAN> Worksheet
<SPAN style="color:#00007F">Dim</SPAN> InnerSheet <SPAN style="color:#00007F">As</SPAN> Worksheet
<SPAN style="color:#00007F">Dim</SPAN> Wk <SPAN style="color:#00007F">As</SPAN> Workbook
<SPAN style="color:#00007F">Dim</SPAN> Region <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> SM <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">Set</SPAN> ThisSheet = ActiveSheet

<SPAN style="color:#00007F">With</SPAN> ThisSheet
<SPAN style="color:#007F00">'Turn off AutoFilters</SPAN>
.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#007F00">'Filter out all unique Region _
and put them in Column E</SPAN>
.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
.Range("E1"), Unique:=<SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#007F00">'Loop through and filter by all unique Regions _
then create a worbbook named after each Region.</SPAN>
<SPAN style="color:#007F00">'Then copy the data for that Region to it's sheet</SPAN>
<SPAN style="color:#00007F">For</SPAN> i = 2 <SPAN style="color:#00007F">To</SPAN> WorksheetFunction.CountA(.Columns("E:E"))
Region = .Cells(i, 5)

<SPAN style="color:#007F00">'Turn on Autofilter if needed</SPAN>
<SPAN style="color:#00007F">If</SPAN> .AutoFilterMode = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> .Rows(1).AutoFilter

<SPAN style="color:#007F00">'Filter down by Region and copy visible cells _
of columns A:D</SPAN>
.Rows(1).AutoFilter Field:=3, Criteria1:=Region
.Columns("A:D").SpecialCells(xlVisible).Copy

<SPAN style="color:#007F00">'Adding new workbook for each region</SPAN>

<SPAN style="color:#00007F">Set</SPAN> Wk = Workbooks.Add
Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN>

<SPAN style="color:#007F00">'Paste new region level data dump on sheet</SPAN>
ActiveSheet.Paste

<SPAN style="color:#007F00">'New Region level data manipulation starts in workbook</SPAN>
<SPAN style="color:#00007F">Set</SPAN> InnerSheet = ActiveSheet
<SPAN style="color:#007F00">' The value of InnerSheet read 'Nothing' Is this a problem</SPAN>
<SPAN style="color:#00007F">With</SPAN> InnerSheet
<SPAN style="color:#007F00">'Turn off AutoFilters</SPAN>
.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#007F00">'Filter out all unique Sales Managers _
and put them in Column E</SPAN>
.Columns(2).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
.Range("E1"), Unique:=<SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#007F00">'Loop through and filter by all unique Sales Manager _
then create a worksheet named after each Sales Manager.</SPAN>
<SPAN style="color:#007F00">'Then copy the data for that Sales Manager to it's sheet</SPAN>
    <SPAN style="color:#00007F">For</SPAN> j = 2 <SPAN style="color:#00007F">To</SPAN> WorksheetFunction.CountA(.Columns("E:E"))
        SM = .Cells(i, 5)
        
            <SPAN style="color:#007F00">'Turn on Autofilter if needed</SPAN>
            <SPAN style="color:#00007F">If</SPAN> .AutoFilterMode = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> .Rows(1).AutoFilter
            
            <SPAN style="color:#007F00">'Filter down by Sales Manager and copy visible cells _
            of columns A:D</SPAN>
            .Rows(1).AutoFilter Field:=2, Criteria1:=SM
            .Columns("A:D").SpecialCells(xlVisible).Copy
        
            <SPAN style="color:#007F00">'=====Error Message in Here</SPAN>
            <SPAN style="color:#007F00">'Add a sheet named after SM</SPAN>
            <SPAN style="color:#007F00">' for the value of j=2 it adds a sheet but for next j value it still reads j=2 with error " Cannot rename the sheet</SPAN>
            Sheets.Add().Name = SM
            <SPAN style="color:#007F00">'=====Error Message in Here</SPAN>
            
            <SPAN style="color:#007F00">'Paste new data on sheet</SPAN>
            ActiveSheet.Paste

   <SPAN style="color:#00007F">Next</SPAN> j
  
    Wk.SaveAs Filename:="C:/" & Region
    ActiveWorkbook.Close <SPAN style="color:#00007F">True</SPAN>
      <SPAN style="color:#007F00">'Here is where I was getting error (at Next i) - Compile Error: <SPAN style="color:#00007F">Next</SPAN> without for</SPAN>
      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN> <SPAN style="color:#007F00">'This piece of code was missing</SPAN>
Next i
  
.AutoFilterMode = <SPAN style="color:#00007F">False</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">Set</SPAN> ThisSheet = <SPAN style="color:#00007F">Nothing</SPAN>
Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN>
Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

====
 
Upvote 0
Got some small sample worksheet data to post too? It helps (me at least) if I can copy your data to a worksheet and "play computer," as it were. Thanks!
 
Upvote 0
stupid of me

I am looking for an option to attach the sample file. Really can't figure this one out. there are A-W columns.
 
Upvote 0
here you go..
Book2
ABCDEFGHIJKLMNOPQRSTUVW
1Subtotal-loanamt???
2loan_numberapplication_dateAcct_ExecSales_Mgrregion_nmdivision_nmloan_amountbranch_nameborrower_namebrokerdata1data2data3data4data5data6data7data8data9data9data10data11data12
31238/23/0412:00AMabcrewinddummy1EastDivision$53,040northkacsonabc,inc7.959.11.2500
44569/8/0412:00AMxyzforwarddumm2EastDivision$121,550southmikexyz,inc8.158.40.2500
Sheet2


I was wondernig if i can have a header on the top with subtotal for that column. Caveat! This will require all my autofilters to be added to second row and also this is pasted dynamically and the code is as follows:<font face=Courier New><SPAN style="color:#00007F">Public</SPAN><SPAN style="color:#00007F">Function</SPAN> IsWsBlank(wsName<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN>,<SPAN style="color:#00007F">Optional</SPAN> wbName<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN>)<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Boolean</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> cnt<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">If</SPAN> ActiveWorkbook<SPAN style="color:#00007F">Is</SPAN><SPAN style="color:#00007F">Nothing</SPAN><SPAN style="color:#00007F">Then</SPAN><SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">Function</SPAN>
    <SPAN style="color:#00007F">If</SPAN> wbName = ""<SPAN style="color:#00007F">Then</SPAN> wbName = ActiveWorkbook.Name
    cnt = Application.CountA(Workbooks(wbName).Sheets(wsName).Cells)
    <SPAN style="color:#00007F">If</SPAN> cnt = 0<SPAN style="color:#00007F">Then</SPAN> IsWsBlank =<SPAN style="color:#00007F">True</SPAN><SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Function</SPAN><SPAN style="color:#00007F">Sub</SPAN> CreateRegion()<SPAN style="color:#00007F">Dim</SPAN> i<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN><SPAN style="color:#00007F">Dim</SPAN> j<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN><SPAN style="color:#00007F">Dim</SPAN> SheetCount<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN><SPAN style="color:#00007F">Dim</SPAN> a<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN><SPAN style="color:#00007F">Dim</SPAN> b<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Integer</SPAN><SPAN style="color:#00007F">Dim</SPAN> strStamp<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN><SPAN style="color:#00007F">Dim</SPAN> Mstr<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN><SPAN style="color:#00007F">Dim</SPAN> ThisSheet<SPAN style="color:#00007F">As</SPAN> Worksheet<SPAN style="color:#00007F">Dim</SPAN> InnerSheet<SPAN style="color:#00007F">As</SPAN> Worksheet<SPAN style="color:#00007F">Dim</SPAN> ws<SPAN style="color:#00007F">As</SPAN> Worksheet<SPAN style="color:#00007F">Dim</SPAN> wis<SPAN style="color:#00007F">As</SPAN> Worksheet<SPAN style="color:#00007F">Dim</SPAN> wss<SPAN style="color:#00007F">As</SPAN> Worksheet<SPAN style="color:#00007F">Dim</SPAN> Wk<SPAN style="color:#00007F">As</SPAN> Workbook<SPAN style="color:#00007F">Dim</SPAN> region_nm<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN><SPAN style="color:#00007F">Dim</SPAN> Sales_Mgr<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN><SPAN style="color:#00007F">Dim</SPAN> Start<SPAN style="color:#00007F">As</SPAN> Worksheet<SPAN style="color:#00007F">Dim</SPAN> LastRow<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>, LastCol<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>
Application.ScreenUpdating =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#00007F">Set</SPAN> ThisSheet = ActiveSheet<SPAN style="color:#007F00">'Code to Create "excel_rpts" folder under C drive to store all reports start here</SPAN>
            
            <SPAN style="color:#00007F">Const</SPAN> myPath = "C:\excel_rpts\"
            
            <SPAN style="color:#00007F">Dim</SPAN> FileName<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN>, FolderName<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">String</SPAN>
            <SPAN style="color:#00007F">Dim</SPAN> fs<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Object</SPAN>, chk<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Boolean</SPAN>
            
            FolderName = myPath
            
            <SPAN style="color:#007F00">'checks if folder exists</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> fs = CreateObject("Scripting.FileSystemObject")
            chk = fs.folderexists(FolderName)
            
            <SPAN style="color:#00007F">If</SPAN> chk =<SPAN style="color:#00007F">True</SPAN><SPAN style="color:#00007F">Then</SPAN>
            MsgBox ("Folder excel_rpts already exists under C drive")
            
            <SPAN style="color:#00007F">Else</SPAN>
            <SPAN style="color:#007F00">'if folder does not exist, create folder</SPAN>
            <SPAN style="color:#00007F">If</SPAN> chk =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#00007F">Then</SPAN> fs.createfolder (FolderName)
            MsgBox ("Folder excel_rpts created under C drive")
            <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN><SPAN style="color:#007F00">'Code to Create "excel_rpts" folder under C drive to store all reports ends here</SPAN><SPAN style="color:#00007F">With</SPAN> ThisSheet<SPAN style="color:#007F00">'Turn off AutoFilters</SPAN>
.AutoFilterMode =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#007F00">'Filter out all unique region_nm _
and put them in Column X</SPAN>
.Columns(5).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
.Range("X1"), Unique:=<SPAN style="color:#00007F">True</SPAN><SPAN style="color:#007F00">'Loop through and filter by all unique region_nm _
then create a workbook named after each Region.</SPAN><SPAN style="color:#007F00">'Then copy the data for that Region to it's sheet</SPAN><SPAN style="color:#00007F">For</SPAN> i = 2<SPAN style="color:#00007F">To</SPAN> WorksheetFunction.CountA(.Columns("X:X"))
region_nm = .Cells(i, 24)<SPAN style="color:#007F00">'Turn on Autofilter if needed</SPAN><SPAN style="color:#00007F">If</SPAN> .AutoFilterMode =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#00007F">Then</SPAN> .Rows(1).AutoFilter<SPAN style="color:#007F00">'Filter down by Region and copy visible cells _
of columns A:W</SPAN>
.Rows(1).AutoFilter Field:=5, Criteria1:=region_nm
.Columns("A:W").SpecialCells(xlVisible).Copy<SPAN style="color:#007F00">'Adding new workbook for each region</SPAN><SPAN style="color:#00007F">Set</SPAN> Wk = Workbooks.Add
Application.DisplayAlerts =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#007F00">'Paste new region level data dump on sheet</SPAN>
ActiveSheet.Paste<SPAN style="color:#007F00">'New Region level data manipulation starts in workbook</SPAN><SPAN style="color:#00007F">Set</SPAN> InnerSheet = ActiveSheet<SPAN style="color:#007F00">' The value of InnerSheet read 'Nothing' Is this a problem</SPAN><SPAN style="color:#00007F">With</SPAN> InnerSheet<SPAN style="color:#007F00">'Turn off AutoFilters</SPAN>
.AutoFilterMode =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#007F00">'Filter out all unique Sales Managers _
and put them in Column X</SPAN>
.Columns(4).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
.Range("X1"), Unique:=<SPAN style="color:#00007F">True</SPAN><SPAN style="color:#007F00">'Loop through and filter by all unique Sales Manager _
then create a worksheet named after each Sales Manager.</SPAN><SPAN style="color:#007F00">'Then copy the data for that Sales Manager to it's sheet</SPAN>
    <SPAN style="color:#00007F">For</SPAN> j = 2<SPAN style="color:#00007F">To</SPAN> WorksheetFunction.CountA(.Columns("X:X"))
        Sales_Mgr = .Cells(j, 24)
        
            <SPAN style="color:#007F00">'Turn on Autofilter if needed</SPAN>
            <SPAN style="color:#00007F">If</SPAN> .AutoFilterMode =<SPAN style="color:#00007F">False</SPAN><SPAN style="color:#00007F">Then</SPAN> .Rows(1).AutoFilter
            
            <SPAN style="color:#007F00">'Filter down by Sales Manager and copy visible cells _
            of columns A:W</SPAN>
            .Rows(1).AutoFilter Field:=4, Criteria1:=Sales_Mgr
            .Columns("A:W").SpecialCells(xlVisible).Copy
        
            <SPAN style="color:#007F00">'Add a sheet named after Sales_Mgr</SPAN>
                      
            <SPAN style="color:#007F00">'Restrict the length of Sales_Mgr name to 31 chars</SPAN>
            <SPAN style="color:#00007F">If</SPAN> Len(Sales_Mgr) > 31<SPAN style="color:#00007F">Then</SPAN> Sales_Mgr = Left(Sales_Mgr, 31)
            <SPAN style="color:#00007F">If</SPAN> Sales_Mgr = "N/A N/A"<SPAN style="color:#00007F">Then</SPAN> Sales_Mgr = "N-A - N-A"
            
            Sheets.Add().Name = Sales_Mgr
            
            
            <SPAN style="color:#007F00">'Paste new data on sheet</SPAN>
            ActiveSheet.Paste

  <SPAN style="color:#00007F">Next</SPAN> j
  
      <SPAN style="color:#007F00">'Code for Deleting Blank worksheets starts here</SPAN>
  
                <SPAN style="color:#00007F">With</SPAN> Application
                    <SPAN style="color:#007F00">'   Suppress Messages</SPAN>
                    .DisplayAlerts =<SPAN style="color:#00007F">False</SPAN>
                    <SPAN style="color:#007F00">'   Stop Screen "Flashing"</SPAN>
                    .ScreenUpdating =<SPAN style="color:#00007F">False</SPAN>
                    
                    <SPAN style="color:#007F00">'   Delete Unused Worksheets</SPAN>
                    <SPAN style="color:#00007F">For</SPAN><SPAN style="color:#00007F">Each</SPAN> ws<SPAN style="color:#00007F">In</SPAN> Worksheets
                          <SPAN style="color:#00007F">If</SPAN> WorksheetFunction.CountA(ws.Cells) = 0<SPAN style="color:#00007F">Then</SPAN>
                              ws.Delete
                          <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
                    <SPAN style="color:#00007F">Next</SPAN> ws
                    
                    .DisplayAlerts =<SPAN style="color:#00007F">True</SPAN>
                    .ScreenUpdating =<SPAN style="color:#00007F">True</SPAN>
                <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>

  
  
  <SPAN style="color:#007F00">'Code for Deleting Blank worksheets ends here</SPAN>
      
  <SPAN style="color:#007F00">'Sorting of the worksheet starts from here</SPAN>
  

                SheetCount = Worksheets.Count
                
                <SPAN style="color:#00007F">If</SPAN> SheetCount< 2<SPAN style="color:#00007F">Then</SPAN>
                    <SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">Sub</SPAN>
                <SPAN style="color:#00007F">Else</SPAN>
                    <SPAN style="color:#00007F">For</SPAN> c = 1<SPAN style="color:#00007F">To</SPAN> SheetCount
                    <SPAN style="color:#00007F">For</SPAN> a = 1<SPAN style="color:#00007F">To</SPAN> SheetCount - 1
                    <SPAN style="color:#00007F">For</SPAN> b = a + 1<SPAN style="color:#00007F">To</SPAN> SheetCount
                    
                    <SPAN style="color:#00007F">If</SPAN> Worksheets(b).Name< Worksheets(a).Name<SPAN style="color:#00007F">Then</SPAN>
                        Worksheets(b).Move Before:=Worksheets(a)
                    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
                    
                    <SPAN style="color:#00007F">Next</SPAN> b
                    
                    <SPAN style="color:#00007F">Next</SPAN> a
                    
                    <SPAN style="color:#00007F">If</SPAN> Worksheets(c).Name = "Sheet1"<SPAN style="color:#00007F">Then</SPAN>
                    Worksheets(c).Move After:=Worksheets(SheetCount)
                    <SPAN style="color:#00007F">If</SPAN> region_nm = "N/A"<SPAN style="color:#00007F">Then</SPAN> region_nm = "N-A"
                    Mstr = "Master Data - " & region_nm
                    <SPAN style="color:#00007F">If</SPAN> Len(Mstr) > 31<SPAN style="color:#00007F">Then</SPAN> Mstr = Left(Mstr, 31)
                    
                    Worksheets(SheetCount).Name = Mstr
                    Selection.AutoFilter
                    <SPAN style="color:#00007F">GoTo</SPAN> fmt:
                    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
                    <SPAN style="color:#00007F">Next</SPAN> c
                    
                <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
  
  <SPAN style="color:#007F00">'Sorting of the worksheet ends from here</SPAN>

  

  
  <SPAN style="color:#007F00">'Formatting of the report starts here</SPAN>
  
fmt:
                Application.ScreenUpdating =<SPAN style="color:#00007F">False</SPAN>
                <SPAN style="color:#00007F">For</SPAN><SPAN style="color:#00007F">Each</SPAN> ws<SPAN style="color:#00007F">In</SPAN> ActiveWorkbook.Worksheets
                ws.Activate
                
                <SPAN style="color:#00007F">With</SPAN> ActiveSheet
                
                <SPAN style="color:#007F00">'===</SPAN>
                        
    <SPAN style="color:#00007F">If</SPAN> ActiveWorkbook<SPAN style="color:#00007F">Is</SPAN><SPAN style="color:#00007F">Nothing</SPAN><SPAN style="color:#00007F">Then</SPAN><SPAN style="color:#00007F">Exit</SPAN><SPAN style="color:#00007F">Sub</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> Start = ActiveSheet
    <SPAN style="color:#00007F">For</SPAN><SPAN style="color:#00007F">Each</SPAN> wis<SPAN style="color:#00007F">In</SPAN> ActiveWorkbook.Worksheets
        <SPAN style="color:#00007F">If</SPAN><SPAN style="color:#00007F">Not</SPAN> IsWsBlank(wis.Name, wis.Parent.Name)<SPAN style="color:#00007F">Then</SPAN>
            LastRow = wis.Cells.Find("*", After:=wis.Cells(1, 1), _
                                    searchorder:=xlByRows, _
                                    searchdirection:=xlPrevious).Row
            LastCol = wis.Cells.Find("*", After:=wis.Cells(1, 1), _
                                    searchorder:=xlByColumns, _
                                    searchdirection:=xlPrevious).Column
            <SPAN style="color:#00007F">With</SPAN> wis.Range("A1", wis.Cells(LastRow, LastCol))
                .BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
                .Borders(xlInsideVertical).Weight = xlThin
                .Borders(xlInsideHorizontal).Weight = xlThin
                wis.Activate
                ActiveWindow.DisplayGridlines =<SPAN style="color:#00007F">False</SPAN>
            <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
        <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> wis
    Start.Select
                <SPAN style="color:#007F00">'===</SPAN>
                .Range("A1:W1").Select
                Selection.AutoFilter
                <SPAN style="color:#007F00">'ActiveSheet.UsedRange.Select</SPAN>
                Selection.AutoFormat Format:=xlRangeAutoFormatList1, Number:=True, Font:= _
                        <SPAN style="color:#00007F">True</SPAN>, Alignment:=True, Border:=<SPAN style="color:#00007F">True</SPAN>, Pattern:=<SPAN style="color:#00007F">True</SPAN>, Width:= _
                        <SPAN style="color:#00007F">True</SPAN>
                
                .Cells.Select
                .Cells.EntireColumn.AutoFit
                
                <SPAN style="color:#007F00">'small code to take care of print preview and Orientation</SPAN>
                <SPAN style="color:#00007F">With</SPAN> Sheets(ws.Name).PageSetup
                .PrintTitleRows = "$1:$23"
                .Orientation = xlLandscape
                .FitToPagesTall =<SPAN style="color:#00007F">False</SPAN>
                .FitToPagesWide = 1
                .Zoom =<SPAN style="color:#00007F">False</SPAN>
                
              

                <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
                <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
                <SPAN style="color:#00007F">Next</SPAN> ws
  
  <SPAN style="color:#007F00">'Formatting of the report ends here</SPAN>
  
  <SPAN style="color:#007F00">'Append timestamp to files created</SPAN>
    strStamp = Format(Now, "dd-mmmm-yy hhmm")
    ChDrive "C"
    CurDir ("C:\excel_rpts\")
    <SPAN style="color:#00007F">If</SPAN> region_nm = "N/A"<SPAN style="color:#00007F">Then</SPAN> region_nm = "N-A"
    Wk.SaveAs FileName:="C:\excel_rpts\" & region_nm & " " & strStamp & ".xls"
    ActiveWorkbook.Close True
    
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN><SPAN style="color:#00007F">Next</SPAN> i
  <SPAN style="color:#007F00">'.AutoFilterMode = False</SPAN><SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN><SPAN style="color:#00007F">Set</SPAN> ThisSheet =<SPAN style="color:#00007F">Nothing</SPAN>
Application.CutCopyMode =<SPAN style="color:#00007F">False</SPAN>
Application.ScreenUpdating = True<SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Sub</SPAN></FONT>
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,291
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top