Loop Macros across Worksheets

S

shizzle5

New Member
Joined
Nov 3, 2015
Messages
2
Firstly, thank your to everyone who posts on this site!
I have looked through multiple forums, attempted to follow the advice, all to no avail.

So here's my simple problem: I want to run a macro that repeats the same very simple tasks (some insert columns, some formulas) on all worksheets in a workbook.

I can manually run the same macro on each individual tab, but that's not scaleable. I would rather run the macro once and have each worksheet magically updated. :)

So here's my code:

Sub Insert_Name_Period()
' Keyboard Shortcut: Ctrl+Shift+I


Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets


Columns("A:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
ActiveCell.FormulaR1C1 = "Name"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Month"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Name+Month"
Range("D2").Select
Selection.Copy
Range("A2:C2").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
Columns("A:A").ColumnWidth = 15.67
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C2").Select
Columns("C:C").ColumnWidth = 23.67
Range("A3").Select
ActiveCell.FormulaR1C1 = _
"=MID(CELL(""filename"",R[-2]C),FIND(""]"",CELL(""filename"",R[-2]C))+1,256)"
Range("A3").Select
ActiveWindow.SmallScroll Down:=186
Range("A3:A200").Select
Selection.FillDown
Range("B3").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(R[-1]C=""3 Total"",R[-1]C=""""),"""",IF(AND(R[-1]C<>1,R[-1]C<>2,R[-1]C<>3,R[-1]C<>""1 Total"",R[-1]C<>""2 Total"",R[-1]C<>""3 Total""),1,IF(AND(RC[2]<>"""",RC[4]="""",RC[12]<>""""),CONCATENATE(R[-1]C,"" Total""),IF(ISERROR(MATCH(""Total"",R[-1]C,1)),R[-1]C,R[-2]C+1))))"
Range("B3").Select
ActiveWindow.SmallScroll Down:=186
Range("B3:B201").Select
Selection.FillDown
ActiveWindow.SmallScroll Down:=-249
Range("C3").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" - "",RC[-1])"
Range("C3").Select
ActiveWindow.SmallScroll Down:=180
Range("C3:C200").Select
Selection.FillDown
Range("A2").Select


Next ws


End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
sheet1.select
macro code
sheet2.select

and so on copy and paste the code as many times as you need it
 
Upvote 0
oldbrewer: Even though that method does work. It can be done much more simply using the following code.

You have to have the macro select the next worksheet or it will just run over and over on the active worksheet.

Code: 
Sub Insert_Name_Period()' Keyboard Shortcut: Ctrl+Shift+I

Dim ws As Worksheet
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
    With ws
    ws.Select
    Columns("A:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Month"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Name+Month"
    Range("D2").Select
    Selection.Copy
    Range("A2:C2").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select
    Columns("A:A").ColumnWidth = 15.67
    Columns("B:B").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    Range("C2").Select
    Columns("C:C").ColumnWidth = 23.67
    Range("A3").Select
    ActiveCell.FormulaR1C1 = _
    "=MID(CELL(""filename"",R[-2]C),FIND(""]"",CELL(""filename"",R[-2]C))+1,256)"
    Range("A3").Select
    Range("A3:A200").Select
    Selection.FillDown
    Range("B3").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(OR(R[-1]C=""3 Total"",R[-1]C=""""),"""",IF(AND(R[-1]C<>1,R[-1]C<>2,R[-1]C<>3,R[-1]C<>""1 Total"",R[-1]C<>""2 Total"",R[-1]C<>""3 Total""),1,IF(AND(RC[2]<>"""",RC[4]="""",RC[12]<>""""),CONCATENATE(R[-1]C,"" Total""),IF(ISERROR(MATCH(""Total"",R[-1]C,1)),R[-1]C,R[-2]C+1))))"
    Range("B3").Select
    Range("B3:B201").Select
    Selection.FillDown
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" - "",RC[-1])"
    Range("C3").Select
    Range("C3:C200").Select
    Selection.FillDown
    Range("A2").Select
    End With


Next ws

Application.ScreenUpdating = True


End Sub
 
Last edited:
Upvote 0
Try this.
Code: 
Sub Insert_Name_Period()
    ' Keyboard Shortcut: Ctrl+Shift+I


Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets

        With ws
            .Columns("A:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            
            .Range("A2:C2").Value = Array("Name", "Month", "Month+Name")
                     
            .Range("D2").Copy
            
            .Range("A2:C2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                                         SkipBlanks:=False, Transpose:=False
                                         
            .Columns("A:A").ColumnWidth = 15.67
            
            With .Columns("B:B")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            
            .Columns("C:C").ColumnWidth = 23.67
            
            .Range("A3:A200").FormulaR1C1 = _
            "=MID(CELL(""filename"",R[-2]C),FIND(""]"",CELL(""filename"",R[-2]C))+1,256)"
            
            .Range("B3:B201").FormulaR1C1 = _
            "=IF(OR(R[-1]C=""3 Total"",R[-1]C=""""),"""",IF(AND(R[-1]C<>1,R[-1]C<>2,R[-1]C<>3,R[-1]C<>""1 Total"",R[-1]C<>""2 Total"",R[-1]C<>""3 Total""),1,IF(AND(RC[2]<>"""",RC[4]="""",RC[12]<>""""),CONCATENATE(R[-1]C,"" Total""),IF(ISERROR(MATCH(""Total"",R[-1]C,1)),R[-1]C,R[-2]C+1))))"
            
            .Range("C3:C200").FormulaR1C1 = "=CONCATENATE(RC[-2],"" - "",RC[-1])"
        End With

    Next ws


End Sub
 
Upvote 0
This worked!! That was precisely what was occurring previously (the macro was just repeating over and over again in the same worksheet). I am not (YET!) familiar enough with VBA code to debug myself, but hopefully over time and lots of Lynda.com courses, I'll get there. THANK YOU!!


smpatty08 said:
oldbrewer: Even though that method does work. It can be done much more simply using the following code.

You have to have the macro select the next worksheet or it will just run over and over on the active worksheet.

Code: 
Sub Insert_Name_Period()' Keyboard Shortcut: Ctrl+Shift+I

Dim ws As Worksheet
Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets
    With ws
    ws.Select
    Columns("A:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "Month"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "Name+Month"
    Range("D2").Select
    Selection.Copy
    Range("A2:C2").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select
    Columns("A:A").ColumnWidth = 15.67
    Columns("B:B").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
    Range("C2").Select
    Columns("C:C").ColumnWidth = 23.67
    Range("A3").Select
    ActiveCell.FormulaR1C1 = _
    "=MID(CELL(""filename"",R[-2]C),FIND(""]"",CELL(""filename"",R[-2]C))+1,256)"
    Range("A3").Select
    ActiveWindow.SmallScroll Down:=186
    Range("A3:A200").Select
    Selection.FillDown
    Range("B3").Select
    ActiveCell.FormulaR1C1 = _
    "=IF(OR(R[-1]C=""3 Total"",R[-1]C=""""),"""",IF(AND(R[-1]C<>1,R[-1]C<>2,R[-1]C<>3,R[-1]C<>""1 Total"",R[-1]C<>""2 Total"",R[-1]C<>""3 Total""),1,IF(AND(RC[2]<>"""",RC[4]="""",RC[12]<>""""),CONCATENATE(R[-1]C,"" Total""),IF(ISERROR(MATCH(""Total"",R[-1]C,1)),R[-1]C,R[-2]C+1))))"
    Range("B3").Select
    ActiveWindow.SmallScroll Down:=186
    Range("B3:B201").Select
    Selection.FillDown
    ActiveWindow.SmallScroll Down:=-249
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" - "",RC[-1])"
    Range("C3").Select
    ActiveWindow.SmallScroll Down:=180
    Range("C3:C200").Select
    Selection.FillDown
    Range("A2").Select
    End With


Next ws

Application.ScreenUpdating = True


End Sub
Click to expand...
 
Upvote 0
I tried to update my code, but if you remove the small scroll sections of your code this will work more effectively. When screen updating is turned off it ignores those but when it is turned on again at the end it scrolls the screen down so you can't see the work the macro did. They are unnecessary anyway, but excel likes to include them when using the macro recorder.

I'm glad I could help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
961
Joe4
Joe4
C
  • Question
Loop/Repeat Macro
2
Replies
11
Views
369
kvsrinivasamurthy
K
P
  • Question
Help with Vba Code
Replies
3
Views
159
Coyotex3
C
L
  • Question
Variable Rows, Help Speeding Up
Replies
4
Views
316
kevin9999
K
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
208
Coco1
C

Forum statistics

Threads
1,214,912
Messages
6,122,200
Members
449,072
Latest member
DW Draft

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