Assigning a "cleaners" word for every worksheet every 7 days and moving it to another person after a week.

[FlipEternalX]

Hello everyone, I hope you are doing great.

I want to add a word "Cleaners" for every worksheet on the workbook.

So for example, Today is Monday. So the "Cleaners" word will be added to Jane so the name of the worksheet of Jane will be Jane (Cleaners)

And then after that, I also want to move the "Cleaners" word after 1 week, so after 1 week the word Cleaners will be put to "Jayvee" then the Cleaners word on Jane will be removed.

Then same with Lorie.

I hope you help me with this problem.

Thank you all.

 

[shknbk2]

This seems to work in some testing using various dates. The OriginalDate should be a Sunday of the week that Jane is scheduled to be the cleaner. It only has to be set once and not every time she comes up. The code will cycle around through the sheets based on this original date. Adding new sheets should also work fine without changing any of the code.

The procedure below is a standard procedure that runs when you tell it to. If you need it to automatically run when you open the workbook, for example, it can be made to do so. Let me know if you need help with this.

Sub AssignCleaners()
    Dim OriginalDate As Date
    Dim Weeks As Integer
    Dim SheetNum As Integer
    Dim sh As Worksheet
    
    OriginalDate = #12/24/2023#
    Weeks = DateDiff("ww", OriginalDate, Now)
    SheetNum = Weeks Mod Sheets.Count + 1
    
    For Each sh In Sheets
        sh.Name = Replace(sh.Name, " (Cleaners)", "")
    Next sh
    Sheets(SheetNum).Name = Sheets(SheetNum).Name & " (Cleaners)"
End Sub

 

[rpaulson]

this code will remove " (Cleaners") from all the sheets. except the active sheet.

Sub do_It()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    If Right(ws.Name, 11) = " (Cleaners)" Then ws.Name = Left(ws.Name, Len(ws.Name) - 11)
Next ws
    
ActiveSheet.Name = ActiveSheet.Name & " (Cleaners)"
    
End Sub

 

[FlipEternalX]

This seems to work in some testing using various dates. The OriginalDate should be a Sunday of the week that Jane is scheduled to be the cleaner. It only has to be set once and not every time she comes up. The code will cycle around through the sheets based on this original date. Adding new sheets should also work fine without changing any of the code.

The procedure below is a standard procedure that runs when you tell it to. If you need it to automatically run when you open the workbook, for example, it can be made to do so. Let me know if you need help with this.

Sub AssignCleaners()
    Dim OriginalDate As Date
    Dim Weeks As Integer
    Dim SheetNum As Integer
    Dim sh As Worksheet
   
    OriginalDate = #12/24/2023#
    Weeks = DateDiff("ww", OriginalDate, Now)
    SheetNum = Weeks Mod Sheets.Count + 1
   
    For Each sh In Sheets
        sh.Name = Replace(sh.Name, " (Cleaners)", "")
    Next sh
    Sheets(SheetNum).Name = Sheets(SheetNum).Name & " (Cleaners)"
End Sub

Hi, thanks for the reply. Based on our workbook, we need to automatically put "Cleaners" every week even if the workbook/worksheet are protected.

 

[FlipEternalX]

this code will remove " (Cleaners") from all the sheets. except the active sheet.

Sub do_It()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    If Right(ws.Name, 11) = " (Cleaners)" Then ws.Name = Left(ws.Name, Len(ws.Name) - 11)
Next ws
   
ActiveSheet.Name = ActiveSheet.Name & " (Cleaners)"
   
End Sub

Hi, this one worked. But I need it to be automatically changed the workbook name and add "Cleaners" every 7 days or 1 week without running the code. Thanks!

 

[shknbk2]

Are both the workbook and the worksheets protected?

 

[FlipEternalX]

Are both the workbook and the worksheets protected?

Hi, Yes. Workbook and all Worksheet are both protected.

 

[shknbk2]

Using my code with the addition of automatically unprotecting the workbook would work. This code goes in the "ThisWorkbook" module. However, unprotecting it automatically as in this example would require putting in the password into the code where anyone could see it (see example below). Alternatively, you could use a message box to ask for the code, but then you would have to either answer it every time you open the workbook, or only ask when a new week has started. There are lots of different scenarios for you to decide on which one is the best.

Private Sub Workbook_Open()
    Dim OriginalDate As Date
    Dim Weeks As Integer
    Dim SheetNum As Integer
    Dim sh As Worksheet
    
   'Change the password to the workbook protection password
    ThisWorkbook.Unprotect "PA$$WORD"

    'Change this date to be the Sunday of the first week (the first sheet to have "Cleaners" added to it)
    OriginalDate = #12/24/2023#
    Weeks = DateDiff("ww", OriginalDate, Now)
    SheetNum = Weeks Mod Sheets.Count + 1
    
    For Each sh In Sheets
        sh.Name = Replace(sh.Name, " (Cleaners)", "")
    Next sh
    Sheets(SheetNum).Name = Sheets(SheetNum).Name & " (Cleaners)"
    ThisWorkbook.Protect Structure:=True, Windows:=False
End Sub

 

[FlipEternalX]

Using my code with the addition of automatically unprotecting the workbook would work. This code goes in the "ThisWorkbook" module. However, unprotecting it automatically as in this example would require putting in the password into the code where anyone could see it (see example below). Alternatively, you could use a message box to ask for the code, but then you would have to either answer it every time you open the workbook, or only ask when a new week has started. There are lots of different scenarios for you to decide on which one is the best.

Private Sub Workbook_Open()
    Dim OriginalDate As Date
    Dim Weeks As Integer
    Dim SheetNum As Integer
    Dim sh As Worksheet
   
   'Change the password to the workbook protection password
    ThisWorkbook.Unprotect "PA$$WORD"

    'Change this date to be the Sunday of the first week (the first sheet to have "Cleaners" added to it)
    OriginalDate = #12/24/2023#
    Weeks = DateDiff("ww", OriginalDate, Now)
    SheetNum = Weeks Mod Sheets.Count + 1
   
    For Each sh In Sheets
        sh.Name = Replace(sh.Name, " (Cleaners)", "")
    Next sh
    Sheets(SheetNum).Name = Sheets(SheetNum).Name & " (Cleaners)"
    ThisWorkbook.Protect Structure:=True, Windows:=False
End Sub

Hi, thank you for this. This is now working, I just have 3 last question, I set the OriginalDate to 12/31/2023 which is Today Sunday. And the Cleaners word is added to Jane which is correct. My question is on January 7 which is sunday too, Do I need to re-run the script to move the word Cleaners to Jayvee and remove the Cleaners from Jane? Or is it automatically even if I didn't run it for next week?

And just to add there are 18 people who are using this and there is 2 batch of Cleaners on this workbook, The example are Jane to Lorie, Cleaners 1 and then for another set of cleaners it's Justin to Jeric Cleaners 2. How can I also run at the same time? For example the cleaners for this week is Jane and Justin, so the Cleaners 1 should be set to Jane (Cleaners 1) and Justin (Cleaners 2).

The last question are, just incase someone resign, how can I modify who will be the cleaners?

Thank you, I appreciate your help.

 

[shknbk2]

Do I need to re-run the script to move the word Cleaners to Jayvee and remove the Cleaners from Jane?

Yes, the script must be rerun to move the word. However, . . .

Or is it automatically even if I didn't run it for next week?

it will automatically be rerun whenever you open the workbook, even if you don't open it for a week. In fact, it reruns every time you open the workbook, so multiple times per day? Multiple days in the same week? It just doesn't appear to change anything because the same sheet is reset with Cleaners.

Now that I think about it, the code I originally provided changes the sheet names even if they don't need it (they already were changed this week). In this code, it checks to see if the designated sheet needs changing. If not, nothing happens. If so, then the sheets are changed.

Private Sub Workbook_Open()
    Dim OriginalDate As Date
    Dim Weeks As Integer
    Dim SheetNum As Integer
    Dim sh As Worksheet
    
    'Change this date to be the Sunday of the first week (the first sheet to have "Cleaners" added to it)
    OriginalDate = #12/24/2023#
    Weeks = DateDiff("ww", OriginalDate, Now)
    SheetNum = Weeks Mod Sheets.Count + 1
    
    If InStr(1, Sheets(SheetNum).Name, "Cleaners") < 1 Then

        'Change the password to the workbook protection password
        ThisWorkbook.Unprotect "PA$$WORD"

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

To see what the code would do next week, pretend that you started this last week and change the date in the code to Dec. 24. Close and reopen the workbook. Since today is the "second" week now, the second sheet should now have Cleaners. Then, change the date back to today.

there are 18 people who are using this and there is 2 batch of Cleaners on this workbook,

The way the code is set up now is strictly based on the number of sheets and their order from left to right. The first sheet gets "Cleaners" today if this is week 0, the second if week 1, etc. This makes it easy if people come and go because you can simply remove or add sheets in the correct order, and the sheet name doesn't matter.

To start having 2 sheets updated requires the code to be changed. It seems easy enough to do if you base it again on the order of the sheets. If you have an even number of sheets and order the cleaners so that the two for each week are next to each other in the sheet order, the code could be changed to use sheets 1-2 the first week, 3-4 the second week, and so on. If you want any other sort of order or there is an odd number of people, then the code would need to get more busy.