Loop Through WorkSheets: Help Needed

[parttime_guy]

Hi,

I have been trying to loop a formatting macro to run on all active sheets using the code below.



Option Explicit

Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'** Perform code here **
Application.Run "'PERSONAL.XLS!formatting1"
'E.g.
'On Error Resume Next 'Will continue if an error results
'ws.Range("A1") = ws.Name
Next ws
End Sub


My formatting code when run on a single worksheet works perfect, I am trying to format all worksheets in the workbook the similar way - (I use the shortcut key manually, I have to run this formatting code on more than 45 worksheets in the same workbook). Can this be automated.

Thanks and Best Regards

[GTO]

My formatting code when run on a single worksheet works perfect, I am trying to format all worksheets in the workbook the similar way - (I use the shortcut key manually, I have to run this formatting code on more than 45 worksheets in the same workbook). Can this be automated...

Greetings parttime_guy,

Yes it can be automated. I presume it's erroring currently???

I do not use a Personal.xls macro file, but I think (as in not tested) that you may be erroring at Application.Run "'PERSONAL.XLS!formatting1" . Try taking out the one single quote mark first. If it does need the quote marks, you are missing one.

Of course another way to solve would be to open your Personal.xls file and just copy the code that's working. Then insert it (substitute) where your Application.Run... is.

Hope this helps,

Mark

[parttime_guy]

Dear GTO,

Thx for showing interest

I have attached the code below but this works only for the 1 sheet - any ideas?



Option Explicit

Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
' Formating Macro
' Keyboard Shortcut: Ctrl+f
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "NAME"
Range("B1").Select
ActiveCell.FormulaR1C1 = "QTY"
Range("C1").Select
ActiveCell.FormulaR1C1 = "RATE"
Range("D1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Rows("2:2").Select
Selection.Delete Shift:=xlUp
Range("A1:D1").Select
Range("D1").Activate
Selection.Font.Bold = True
Range("A1:D10").Select
Range("D10").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1:D1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
' Perform code here
' Application.Run "PERSONAL.XLS!Formating"
'E.g.
'On Error Resume Next 'Will continue if an error results
'ws.Range("A1") = ws.Name
Next ws
End Sub

[parttime_guy]

Greetings parttime_guy,

Yes it can be automated. I presume it's erroring currently???

I do not use a Personal.xls macro file, but I think (as in not tested) that you may be erroring at Application.Run "'PERSONAL.XLS!formatting1" . Try taking out the one single quote mark first. If it does need the quote marks, you are missing one.

Of course another way to solve would be to open your Personal.xls file and just copy the code that's working. Then insert it (substitute) where your Application.Run... is.

Hope this helps,

Mark

Dear GTO,

U were right there was a quote problem - I removed the same but the code works only on the first sheet.

[GTO]

The problem is that the macro recorder records every step you do. Thus, after running thru the loop once, the second loop just repeats the operations on sheet 'A' (or whatever sheet you had active), as the active sheet is still the same.

To correct the current code, above the line that says:


Rows("1:1").Select

add:


ws.Select

Now it will select (and thus activate) ea sheet and perform the commands...

Mark

[GTO]

Now once you take a look at that in action (reduce the code window so you can see the worksheet, then click in the sub and start clicking F8, this will let you step thru the routine and you can see it in action)...

Then you may wish to try the following:


Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
' Formating Macro
' Keyboard Shortcut: Ctrl+f
With ws
.Rows("1:1").Insert Shift:=xlDown
.Range("A1").Value = "NAME"
.Range("B1").Value = "QTY"
.Range("C1").Value = "RATE"
.Range("D1").Value = "TOTAL"
.Rows("2:2").Delete Shift:=xlUp
.Range("A1:D1").Font.Bold = True
With .Range("A1:D10")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
With .Range("A1:D1").Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
End With
Next ws
End Sub

...where we skip selecting everything, and specify the range(s) as we go along. This will run quit a bit quicker.

Have a good one, and hope this helps,

Mark

[parttime_guy]

Dear GTO,

Thanks for your help works like magic!

:clap:

Best regards
:beerchug:

[GTO]

:thumb Happy to help, and have a great weekend,

Mark

[mdmackillop]

or even


Sub LoopThroughSheets()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
.Rows("1:1").Insert Shift:=xlDown
.Rows("2:2").Delete Shift:=xlUp
With .Range("A1:D1")
.Value = Array("NAME", "QTY", "RATE", "TOTAL")
.Font.Bold = True
.Interior.ColorIndex = 6
End With
With .Range("A1:D10").Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Next
End Sub

[GTO]

Hey PartTime_Guy,

That worked out for a nice series/progression that you can see the improvements in. hope this helped.

@MD:

A personal note of thanks :-) WAY crisper; I didn't even know that .Borders would default that way.

Thanks again,

Mark

[parttime_guy]

Guz - another small problem!

Iam trying to use the call function.

formatting1 contains various changes in column width, shading, sub-totals, copy paste as values, removing sub-totals etc.

The formatting1 code has all the "codes" needed to format a single worksheet - this code works fine when used on a single worksheet, but when I use the code below - the code just goes bonkers :banghead: - it runs the code on the first sheet & does not run on other sheets.



Option Explicit

Sub Format()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
Call formatting1
End With
Next ws
End Sub


mdmackillop's code works too.

Any suggestions - can u help me once again plz.: pray2:

Thx-n-BR

[GTO]

Hey there,

MD's code is MUCH nicer, so I hope you chose that. As to current - show us the 'formatting1" procedure. I feel certain that you should be passing an arg to it.

[mdmackillop]

You probably just need to go to the worksheet


With ws
ws.activate
Call formatting1
End With

[Norie]

Why not pass the worksheet(s) as a parameter to the sub formatting1?

[parttime_guy]

Dear MD - u really rock man

This works wonders - Thanks for all ur help.

MD, GTO and Norie Wish u all a very Happy Diwali & a Prosperous New Year.

MD - This code is small but I think it should be in the KB.

Best regards
:thumb :clap: