Loop to Next worksheet

Question

I have a code that works fine for one sheet. My current setup is changing though and I need to run this same code for each worksheet in the workbook.

I was able to get everything to flow through with this code, but then it doesn't change worksheets when it reverts back to Sub Test():

Sub Test()
    Dim lstrow As Long, sht As Worksheet


        For Each sht In ActiveWorkbook.Worksheets
            Call Dupe_Sub
        Next
End Sub

Sub Dupe_Sub()
'Highlight Duplicate Values
Dim sht As Worksheet, lstrow As Long, srcsht As Worksheet
Const UPCCol = "A"

Set srcsht = ActiveWorkbook.ActiveSheet
Set sht = ActiveWorkbook.ActiveSheet
lstrow = sht.Range("A1").CurrentRegion.Rows.Count

    With sht
        Columns("A:A").Select
        Selection.FormatConditions.AddUniqueValues
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        Selection.FormatConditions(1).DupeUnique = xlDuplicate
        With Selection.FormatConditions(1).Font
            .Color = -16383844
            .TintAndShade = 0
        End With
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False

    'Sort Duplicates to top
        Range("A1").Select
        Selection.AutoFilter
        With sht

            .AutoFilter.Sort.SortFields.Add(Range( _
                "A1:A" & lstrow), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
                = RGB(255, 199, 206)
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With
    End With
    Selection.AutoFilter
End Sub

Answer 1

One way is to pass the sheet into your subroutine as parameter. You shouldn't work with ActiveSheet anyhow.

Sub Test()
    Dim lstrow As Long, sht As Worksheet

    For Each sht In ActiveWorkbook.Worksheets
        Call Dupe_Sub(sht)
    Next
End Sub

Sub Dupe_Sub(sht As Worksheet)
   'Highlight Duplicate Values
    Dim lstrow As Long, srcsht As Worksheet
    Const UPCCol = "A"
    With sht 
        ....
    end with
end sub

Remark: Try to get rid of all the select and work with range -objects instead. .

Answer 2

in Sub Test() I would add a line that activates each worksheet before calling Dupe_Sub...

It seems to me that your code runs once for each worksheet, but since it doesn't change the ActiveSheet it is running again and again on the same one.

Answer 3

Sub Test()
  Dim lstrow As Long, sht As Worksheet


    For Each sht In ActiveWorkbook.Worksheets
        Call Dupe_Sub sht
    Next
  End Sub

  Sub Dupe_Sub(sht as Worksheet)
  'Highlight Duplicate Values
  Dim sht As Worksheet, lstrow As Long, srcsht As Worksheet
  Const UPCCol = "A"

  lstrow = sht.Range("A1").CurrentRegion.Rows.Count

  With sht.Columns("A:A")
    .FormatConditions.AddUniqueValues
    .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    .FormatConditions(1).DupeUnique = xlDuplicate
    With .FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
  End With
    .FormatConditions(1).StopIfTrue = False

  'Sort Duplicates to top
    Range("A1").AutoFilter

end with
    With sht

        .AutoFilter.Sort.SortFields.Add(Range( _
            "A1:A" & lstrow), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
            = RGB(255, 199, 206)
        With .AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
  Range("A1").AutoFilter
End Sub

Answer 4

I actually achieved what I was going for with this at the very end of the Dupe_Sub

If ActiveSheet.Index = Worksheets.Count Then
Worksheets(1).Select
Else
ActiveSheet.Next.Select
End If

Thank you for the suggestions though and I will look into doing away with all the "activates."