Overlap changing a worksheet using vba macro

[FlipEternalX]

Hi everyone. Good day.

I am asking for a help regarding my simple problem that I didn't know how to work on.

I have these excel file that change worksheet name depends on week.
On this screenshot once I run the code it will change the first worksheet based on color (I didn't want it to based on color I just want to highlight where the changing of worksheet will start)

Now, the problem is it overlap changing the file when the week for the last sheet is already done.

for example, the "Cleaners 1" is assigned to Lyka for the last week, then after it run it will proceed to Aether which is incorrect, it should be back to Jane. Same problem with orange and green worksheet. can someone help me not to overlap when running the code?

Here is my VBA Macro Code. Thanks!

Private Sub Workbook_Open()
    Dim OriginalDate As Date
    Dim Weeks As Integer
    Dim SheetNum As Integer
    Dim SheetNum1 As Integer
    Dim SheetNum2 As Integer
    Dim sh As Worksheet
    
    
    OriginalDate = #1/21/2024#
    
    Weeks = DateDiff("ww", OriginalDate, Now)
    SheetNum = Weeks Mod Sheets.Count + 1
    SheetNum1 = Weeks Mod Sheets.Count + 7
    SheetNum2 = Weeks Mod Sheets.Count + 12
       
    If InStr(1, Sheets(SheetNum).Name, "Cleaners 1") < 1 Then

        'Workbook protection password
       ' ThisWorkbook.Unprotect "testpassword"

        For Each sh In Sheets
            sh.Name = Replace(sh.Name, " (Cleaners 1)", "")
            sh.Name = Replace(sh.Name, " (Cleaners 2)", "")
            sh.Name = Replace(sh.Name, " (Cleaners 3)", "")
        Next sh
        Sheets(SheetNum).Name = Sheets(SheetNum).Name & " (Cleaners 1)"
        Sheets(SheetNum1).Name = Sheets(SheetNum1).Name & " (Cleaners 2)"
        Sheets(SheetNum2).Name = Sheets(SheetNum2).Name & " (Cleaners 3)"
        'ThisWorkbook.Protect Structure:=True, Windows:=False
        
    End If
End Sub

 

[RoryA]

Isn't this the same question you posted before here?