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?
 
Saqib Husain, SyedEngineerCommented:
Try changing

for each ws in thisworkbook.worksheets

to

for each ws in activeworkbook.worksheets
0
 
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
 
Patrick O'DeaAuthor Commented:
Thanks!

Just perfect!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.