Excel Macro Looping Issue

[mralbatross]

Hi,
Would anyone be able to tell me why this code doesn’t loop to the next worksheet and only performs the task on the active sheet?

I realize my code is poor but this is just a tester for a few additional tasks to be performed within the loop – but at this stage I can’t even get the loop to work!
As always thanks for all the support!


Sub Formatting()
Dim ws As Worksheet
If ws.Visible Then ws.Select (False)
Next

Cells.Select
Range("I30").Activate
With Selection.Font
.Name = "Verdana"
.Size = 10
.Strikethrough = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With Selection.Font
.Name = "Verdana"
.Size = 10
.Strikethrough = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveWindow.Zoom = 83
Range("K30").Select

With Application.FindFormat.Interior
.PatternColorIndex = xlAutomatic
.Color = 8476672
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Application.ReplaceFormat.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True, _
FormulaVersion:=xlReplaceFormula2

End Sub

Thanks!

 

[MARK858]

Try the changes below if you are trying to loop through the visible sheets (untested and I haven't looked at the formatting part bar removing the duplicate part)

Sub Formatting()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Visible Then
            ws.Activate
            Cells.Select
            Range("I30").Activate
            
            With Selection.Font
                .Name = "Verdana"
                .Size = 10
                .Strikethrough = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With

            ActiveWindow.Zoom = 83
            
            Range("K30").Select

            With Application.FindFormat.Interior
                .PatternColorIndex = xlAutomatic
                .Color = 8476672
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            
            With Application.ReplaceFormat.Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
                          xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True, _
                          FormulaVersion:=xlReplaceFormula2
        End If
    Next
End Sub

 

[mralbatross]

Try the changes below if you are trying to loop through the visible sheets (untested and I haven't looked at the formatting part bar removing the duplicate part)

Sub Formatting()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Visible Then
            ws.Activate
            Cells.Select
            Range("I30").Activate
           
            With Selection.Font
                .Name = "Verdana"
                .Size = 10
                .Strikethrough = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With

            ActiveWindow.Zoom = 83
           
            Range("K30").Select

            With Application.FindFormat.Interior
                .PatternColorIndex = xlAutomatic
                .Color = 8476672
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
           
            With Application.ReplaceFormat.Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
                          xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True, _
                          FormulaVersion:=xlReplaceFormula2
        End If
    Next
End Sub

This worked! thanks! Is there a way to run the macro on highlighted sheets only. For example, if I select 10 of the 20 tabs, only those would be updated.

 

[MARK858]

Try...

Sub Formatting()
    Dim ws As Worksheet
   For Each ws In ActiveWindow.SelectedSheets
       
            ws.Activate
            Cells.Select
            Range("I30").Activate
            
            With Selection.Font
                .Name = "Verdana"
                .Size = 10
                .Strikethrough = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With

            ActiveWindow.Zoom = 83
            
            Range("K30").Select

            With Application.FindFormat.Interior
                .PatternColorIndex = xlAutomatic
                .Color = 8476672
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            
            With Application.ReplaceFormat.Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorLight2
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
                          xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True, _
                          FormulaVersion:=xlReplaceFormula2
        
    Next
End Sub