Looping through all sheets and formatting

See attached code.  (Needs some tidying but that is for tomorrow!)

This code formats a sheet with totals, bold etc.

However, I want to change the code so that it runs for ALL the sheets in my workbook.
I will not know the names of the sheets.

How do I run this code for ALL sheets.

(Presumably by adding a simple loop .... but I cannot get this to work.)

Thanks!


Sub FormatSales()
'
' FormatSales Macro
'

'
   On Error GoTo FormatSales_Error



    Columns("A:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("N:AQ").Select
    Selection.EntireColumn.Hidden = True
    ActiveWindow.ScrollColumn = 5
    Cells.Select
    
    
  
    Rows("1:1").Select
    Columns("G:J").Select
    Selection.NumberFormat = "#,##0"
    Cells.Select
    Range("F1").Activate
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8, 9, 10 _
        ), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveWindow.LargeScroll ToRight:=-1
   
    Cells.Select
    Range("F1").Activate
    Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(7, 8, 9, 10 _
        ), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        
   FixSubTotal
   AddPercentageForSubTotals
   'SortSheets
    
   
   
   Rows(1).Insert
    Rows(1).Insert
    Rows(1).Insert
    Range("f" & "1").Value = Range("a" & "10").Value & " - " & Range("b" & "10").Value & " - " & Range("c" & "10").Value
    
    
    
    
    
    Cells.Select
    Range("F1").Activate
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        End With

    
    
     
    Range("F" & "1").Font.Bold = True

    Rows("4:4").Font.Bold = True
    Columns("F:F").ColumnWidth = 26.57
    Columns("K:K").Select
    Selection.NumberFormat = "0% ;[Red]-0% "
    Columns("J:J").Select
    Selection.NumberFormat = "_-* #,##0_-;[Red]-* #,##0_-;_-* ""-""??_-;_-@_-"

        
   On Error GoTo 0
   Exit Sub

FormatSales_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatSales of Module Module1"

   End Sub
   
   Sub AddPercentageForSubTotals()
   
   Dim xLast_Row As Long
Dim xCell As Range

   On Error GoTo AddPercentageForSubTotals_Error

xLast_Row = Range("E" & Rows.Count).End(xlUp).Row
For Each xCell In Range("F2:F" & xLast_Row)


    If Right(xCell.Formula, 5) = "Total" Then
    
    Range("K" & xCell.Row).Value = "=J" & xCell.Row & "/H" & xCell.Row
    
    End If
    
Next

   On Error GoTo 0
   Exit Sub

AddPercentageForSubTotals_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AddPercentageForSubTotals of VBA Document ThisWorkbook"

   End Sub
Sub FixSubTotal()

   Dim i As Long, lastRow As Long
   On Error GoTo FixSubTotal_Error

   lastRow = Range("E" & Rows.Count).End(xlUp).Row
   i = 2
   Do
   
      If Right(Range("E" & i), 5) = "Total" Then
      
        Rows(i).Select
Range("F" & i).Value = Range("E" & i).Value
Range("F" & i).Font.Bold = True


    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
         
         Rows(i + 1).Insert
         Rows(i + 1).Insert
         i = i + 3
         lastRow = lastRow + 2
      Else
         i = i + 1
      End If
   Loop While i <= lastRow

   On Error GoTo 0
   Exit Sub

FixSubTotal_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FixSubTotal of VBA Document ThisWorkbook"
End Sub

Open in new window

Patrick O'DeaAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Saqib Husain, SyedEngineerCommented:
Add this on line 8

for each ws in thisworkbook.worksheets
ws.activate



and this before end sub

next ws
0
Saqib Husain, SyedEngineerCommented:
Sorry change that to

Add this on line 5

for each ws in thisworkbook.worksheets
ws.activate



and this before exit sub

next ws
0
Patrick O'DeaAuthor Commented:
Thanks ssagibh,

There is a further complication that I should have mentioned!

I have 2 workbooks.
See attached.

The macro is stored in WorkBV2.
However, I run the macro in EELoop2 (and all it's sheets).

I understand your suggestion but it does not seem to work in these circumstances.
Any thoughts?



WorkBV2.xlsm
EELoop2.xlsm
0
Saqib Husain, SyedEngineerCommented:
Try changing

for each ws in thisworkbook.worksheets

to

for each ws in activeworkbook.worksheets
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Patrick O'DeaAuthor Commented:
Thanks!

Just perfect!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.