What's the best way to loop code through multiple sheets in the same workbook?

X

xcelnovice101

Active Member
Joined
Aug 24, 2012
Messages
368
Below is my code for the first tab and as you can tell, I'm cheating by using "Sheets(1)". Rather than having to rename each variable and sheet as "Sheets(2)"....., is there a simple of of having excel loop the exact same code provided below for each sheet in the active workbook? If it is possible, I realize I'll need to adjust part of this code that calls out Sheets(1).

Code: 
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
' Insert Date
    Sheets(1).Select
    Columns("C:C").EntireColumn.AutoFit
    Dim SEAD As Long
    SEAD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("D12"), Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
    Dim LEND As Long
    LEND = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("E12"), Range("E" & LEND)).Formula = "=LEN(RC[-2])"
    Dim RGTD As Long
    RGTD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("F12"), Range("F" & RGTD)).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
    Dim VLUD As Long
    VLUD = Range("C" & Cells.Rows.Count).End(xlUp).Row
    Range(Range("B12"), Range("B" & VLUD)).Formula = "=VALUE(RC[4])"
    Range(Range("B12"), Range("B" & VLUD)).Copy
    Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("D12").End(xlDown).ClearContents
    Range("B12").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
    Range("E12:F12").Select
    Range(Selection, Selection.End(xlDown)).ClearContents
    Columns("D:D").EntireColumn.AutoFit
    Columns("D:D").NumberFormat = "m/d/yyyy"
    Columns("F:F").Delete Shift:=xlToLeft
    Range("F12").Select
'Rename Sheets & Save Files
    Dim Port1, Month, Year1, NM As String
    Port1 = Left(Sheets(1).[A2], 4)
    Year1 = Year([D12])
    Month = Format(Sheets(1).[D12], "MMMM")
    Sheets(1).Name = Port1
    NM = Month & " MTD FS Returns.xlsm"
    Sheets(1).Select
    Sheets(1).Copy
    ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.ScreenUpdating = True
End Sub
 
Sort by date Sort by votes
Thanks for the heads up John_w.

Everything right now works perfectly except for the the highlighted line of code.

Code: 
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    With ws
    .Columns("C:C").EntireColumn.AutoFit
    Dim SEAD As Long
    SEAD = .Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(.Range("D12"), .Range("D" & SEAD)).Formula = "=SEARCH("" TO"",RC[-1])"
    Dim LEND As Long
    LEND = .Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(.Range("E12"), .Range("E" & LEND)).Formula = "=LEN(RC[-2])"
    Dim RGTD As Long
    RGTD = .Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(.Range("F12"), .Range("F" & RGTD)).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
    Dim VLUD As Long
    VLUD = .Range("C" & Cells.Rows.Count).End(xlUp).Row
    .Range(.Range("B12"), .Range("B" & VLUD)).Formula = "=VALUE(RC[4])"
    .Range(.Range("B12"), .Range("B" & VLUD)).Copy
    .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Application.CutCopyMode = False
    .Range("D12").End(xlDown).ClearContents
[COLOR=#ff0000]    .Range("B12").Select
[/COLOR]    .Range(Selection, Selection.End(xlDown)).ClearContents
    .Range("E12:F12").Select
    .Range(Selection, Selection.End(xlDown)).ClearContents
    .Columns("D:D").EntireColumn.AutoFit
    .Columns("D:D").NumberFormat = "m/d/yyyy"
    .Columns("F:F").Delete Shift:=xlToLeft
    .Range("F12").Select
'Rename Sheets & Save Files
    Dim Port1, Month, Year1, NM As String
    Port1 = Left(ActiveSheet.[A2], 4)
    Year1 = Year([D12])
    ActiveSheet.Name = Port1
    Month = Format(Sheets(1).[D12], "MMMM")
    NM = Month & " MTD FS Returns.xlsm"
    ActiveSheet.Select
    ActiveSheet.Copy
    ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=False
    End With
Next ws
Application.ScreenUpdating = True
End Sub

This section works just fine on the first loop but on the subsequent loops, it debugs. I beleive it is hung up on the previous tab rather than the current/active one but the rest of the code executes as it should.
 
Upvote 0

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Hi everybody,

xcelnovice101, the Select method of a range requires that the sheet is activated beforehand.
So, by putting this line of code above the red one, it should work :
Code: 
.Select
[COLOR=#FF0000].Range("B12").Select[/COLOR]

If you want to avoid the Select method (which is a better way to optimize your code), you can replace this :
Code: 
[COLOR=#FF0000].Range("B12").Select[/COLOR]
.Range(Selection, Selection.End(xlDown)).ClearContents
.Range("E12:F12").Select
[COLOR=#574123].Range(Selection, Selection.End(xlDown)).ClearContents[/COLOR]
by this :
Code: 
.Range("B12:B" & .Range("B12").End(xlDown).Row).ClearContents
.Range("E12:F" & .Range("E12").End(xlDown).Row).ClearContents
 
Upvote 0
Thanks a lot for the help tunguyen! ".Select" did the trick. As for your other recommendation, I would love to clean up my code but each day I run this report, the ranage changes but the range always has continious data and this is the only way I know how to achieve what I want in VBA.
 
Upvote 0
xcelnovice101 said:
but each day I run this report, the ranage changes
Click to expand...
this part
Code: 
.Range("B12:B" & .Range("B12").End(xlDown).Row).ClearContents
.Range("E12:F" & .Range("E12").End(xlDown).Row).ClearContents
does the same thing as this part
Code: 
.Range("B12").Select
.Range(Selection, Selection.End(xlDown)).ClearContents
.Range("E12:F12").Select
.Range(Selection, Selection.End(xlDown)).ClearContents
It's only another way to write your code.
Even if the last row changes, the .Range("B12").End(xlDown).Row part will detects it automatically.
 
Upvote 0
tinguyen said:
this part
Code: 
.Range("B12:B" & .Range("B12").End(xlDown).Row).ClearContents
.Range("E12:F" & .Range("E12").End(xlDown).Row).ClearContents
does the same thing as this part
Code: 
.Range("B12").Select
.Range(Selection, Selection.End(xlDown)).ClearContents
.Range("E12:F12").Select
.Range(Selection, Selection.End(xlDown)).ClearContents
It's only another way to write your code.
Even if the last row changes, the .Range("B12").End(xlDown).Row part will detects it automatically.
Click to expand...

Thanks tinguyen! I have replaced my section fo code with yours and it works just fine. I'll keep with yours since it's more efficient. Thanks again!
 
Upvote 0
I've given a look to your code and propose you a little more optimized code.
I haven't tested it but it should run the same way as your former code.
There are maybe some modifications to do :
Code: 
Sub FS_MTD_REPORT_v1()
    Dim SEAD As Long
    Dim Port1 As String, Month1 As String, Year1 As String, NM As String


    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            .Columns("C:C").EntireColumn.AutoFit
            'As SEAD = LEND = RGTD = VLUD you only need to declare one variable
            SEAD = .Range("C" & Rows.Count).End(xlUp).Row
            .Range("D12:D" & SEAD).Formula = "=SEARCH("" TO"",RC[-1])"
            .Range("E12:E" & SEAD).Formula = "=LEN(RC[-2])"
            .Range("F12:F" & SEAD).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
            .Range("B12:B" & SEAD).Formula = "=VALUE(RC[4])"
            .Range("B12:B" & SEAD).Copy
            .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Application.CutCopyMode = False
            .Range("D12").End(xlDown).ClearContents
            .Range("B12:B" & SEAD).ClearContents
            .Range("E12:F" & SEAD).ClearContents
            .Columns("D:D").EntireColumn.AutoFit
            .Columns("D:D").NumberFormat = "m/d/yyyy"
            .Columns("F:F").Delete Shift:=xlToLeft
            .Range("F12").Select
            'Rename Sheets & Save Files
            Port1 = Left([A2], 4)
            Year1 = Year([D12])
            ActiveSheet.Name = Port1
            Month1 = Format(Sheets(1).[D12], "MMMM")
            NM = Month1 & " MTD FS Returns.xlsm"
            'ActiveSheet.Select 'you don't need to select an activesheet as it is already activated by definition !
            ActiveSheet.Copy
            ActiveWorkbook.SaveAs Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            ActiveWorkbook.Close savechanges:=False
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
I am having a problem with the following code and I beleive it has something to do with the highlighted section.

Code: 
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
    Sheets(1).Select
    Dim SEADT As Long
    Dim Port1 As String, Month1 As String, Year1 As String, NM As String
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        With ws
            .Columns("C:C").EntireColumn.AutoFit
            SEADT = .Range("C" & Rows.Count).End(xlUp).Row
            .Range("D12:D" & SEADT).Formula = "=SEARCH("" TO"",RC[-1])"
            .Range("E12:E" & SEADT).Formula = "=LEN(RC[-2])"
            .Range("F12:F" & SEADT).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
            .Range("B12:B" & SEADT).Formula = "=VALUE(RC[4])"
            .Range("B12:B" & SEADT).Copy
            .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Application.CutCopyMode = False
            .Range("D12").End(xlDown).ClearContents
            .Range("B12:B" & SEADT).ClearContents
            .Range("E12:F" & SEADT).ClearContents
            .Columns("D:D").EntireColumn.AutoFit
            .Columns("D:D").NumberFormat = "m/d/yyyy"
            .Columns("F:F").Delete Shift:=xlToLeft
'Rename Sheets & Save Files
[COLOR=#ff0000]            Port1 = Left([A2], 4)
            Year1 = Year([D12])
            ActiveSheet.Name = Port1
            Month1 = Format(ActiveSheet.[D12], "MMMM")
[/COLOR]            NM = Month1 & " MTD FS Returns.xlsm"
            ActiveSheet.Copy
            ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & Month1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            ActiveWorkbook.Close savechanges:=False
        End With
    Next ws
'Clears Data for Next Run of Reports
    Dim wss As Worksheet
        For Each wss In ThisWorkbook.Worksheets
            wss.Select
            Cells.Delete Shift:=xlUp
            Range("A1").Select
        Next wss
    Sheets(1).Select
Application.ScreenUpdating = True
End Sub

The code keeps saving each sheet as the first sheet so I don't think it is refencing the next sheet. I wrote the line "Sheets(1).Select" to at the beginning to make sure I always staart and the beginning of the file and loop through the remaining sheets. Is that what the problem is? Is so, how do I fix it and still make sure I loop though all of the sheets?
 
Upvote 0
Got it figured out.
Code: 
Sub FS_MTD_REPORT()
Application.ScreenUpdating = False
    Dim SEADT As Long
    Dim Port1 As String, Month1 As String, Year1 As String, NM As String
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        With ws
            [COLOR=#ff0000]ws.Select
[/COLOR]            .Columns("C:C").EntireColumn.AutoFit
            SEADT = .Range("C" & Rows.Count).End(xlUp).Row
            .Range("D12:D" & SEADT).Formula = "=SEARCH("" TO"",RC[-1])"
            .Range("E12:E" & SEADT).Formula = "=LEN(RC[-2])"
            .Range("F12:F" & SEADT).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
            .Range("B12:B" & SEADT).Formula = "=VALUE(RC[4])"
            .Range("B12:B" & SEADT).Copy
            .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Application.CutCopyMode = False
            .Range("D12").End(xlDown).ClearContents
            .Range("B12:B" & SEADT).ClearContents
            .Range("E12:F" & SEADT).ClearContents
            .Columns("D:D").EntireColumn.AutoFit
            .Columns("D:D").NumberFormat = "m/d/yyyy"
            .Columns("F:F").Delete Shift:=xlToLeft
'Rename Sheets & Save Files
            Port1 = Left([A2], 4)
            Year1 = Year([D12])
            ActiveSheet.Name = Port1
            Month1 = Format(ActiveSheet.[D12], "MMMM")
            NM = Month1 & " MTD FS Returns.xlsm"
            ActiveSheet.Copy
            ActiveWorkbook.saveas Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & Month1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            ActiveWorkbook.Close savechanges:=False
            Cells.Delete Shift:=xlUp
            Range("A1").Select
        End With
    Next ws
    Sheets(1).Select
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Try this version:
Code: 
Sub FS_MTD_REPORT_v1()
    Dim SEAD As Long
    Dim Port1 As String, Month1 As String, Year1 As String, NM As String




    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        With ws
            .Columns("C:C").EntireColumn.AutoFit
            'As SEAD = LEND = RGTD = VLUD you only need to declare one variable
            SEAD = .Range("C" & Rows.Count).End(xlUp).Row
            .Range("D12:D" & SEAD).Formula = "=SEARCH("" TO"",RC[-1])"
            .Range("E12:E" & SEAD).Formula = "=LEN(RC[-2])"
            .Range("F12:F" & SEAD).Formula = "=RIGHT(RC[-3],RC[-1]-RC[-2]-2)"
            .Range("B12:B" & SEAD).Formula = "=VALUE(RC[4])"
            .Range("B12:B" & SEAD).Copy
            .Range("D12").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Application.CutCopyMode = False
            .Range("D12").End(xlDown).ClearContents
            .Range("B12:B" & SEAD).ClearContents
            .Range("E12:F" & SEAD).ClearContents
            .Columns("D:D").EntireColumn.AutoFit
            .Columns("D:D").NumberFormat = "m/d/yyyy"
            .Columns("F:F").Delete Shift:=xlToLeft
            .Range("F12").Select
            'Rename Sheets & Save Files
            Port1 = Left(.[A2], 4)
            Year1 = Year(.[D12])
            .Name = Port1
            Month1 = Format(.[D12], "MMMM")
            NM = Month1 & " MTD FS Returns.xlsm"
            'ActiveSheet.Select 'you don't need to select an activesheet as it is already activated by definition !
            .Copy
            ActiveWorkbook.SaveAs Filename:="K:\Active Equity\Reconciliations\Monthly\" & Port1 & "\" & Year1 & "\" & NM, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
            ActiveWorkbook.Close savechanges:=False
        End With
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
1K
Joe4
Joe4
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
369
RoryA
RoryA
T
  • Solved
VBA Name New column & Use Column Header as Range
Replies
7
Views
556
Peter_SSs
Peter_SSs
C
  • Question
Paste/Select VBA error
Replies
2
Views
89
My Aswer Is This
My Aswer Is This
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
307
Coco1
C

Forum statistics

Threads
1,216,172
Messages
6,129,291
Members
449,498
Latest member
Lee_ray

Share this page

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