Multiple sheets in a workbook rota.

[GaryHealey]

Hi All

I'm having an absolute nightmare trying to sort my rota out, I have 52 sheets (weeks 1 to 52) in a workbook, each worksheet has a table.
I need to update all future sheets if someone leaves or someone joins, I've tried doing this with selecting all sheets, however, they are tables and this is not possible.

I have tried the following macro to change a name on a specific cell but due to my lack of knowledge it causes an error.

Can you please help me?

Cheers

Gary

Sub NAMESROTA()
'
' NAMESROTA Macro
' CHANGE THE NAME ON THE ROTA
'

'Dim Sh As Worksheet
Application.ScreenUpdating = False
For Each Sh In Windows("Rota NMEA Fiscal 2023 2024 .xlsx").Activate
With Sh
Windows("Rota NMEA Fiscal 2023 2024 .xlsx").Activate
Range("B27").Select
ActiveCell.FormulaR1C1 = "Mark Richards"
End With
With Sheets("WEEK 17")
Next Sh

End Sub

 

[RudRud]

Hi, It would be good if you can provide more sample data through mini sheet via XLBB with expected result for better understanding

Want to help your helpers by posting a small, copyable, screen shot directly in your post? XL2BB Instructions & Download (latest January 2021 v 2.0 )

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

Loop through all worksheets in rota workbook,
Then what are you trying to deal with each sheet tables? or each sheetPut B27 as "Mark Richards"?

 

[GaryHealey]

Hi
Thank you for the information, I have deleted the names and replaced them with numbers so some of the links to the first two pages are not working.
It will give you an idea of how I have set it up.

Ideally I would like to be able to change the names, add new people, remove new people for every sheet in 1 motion rather than having to repeat it 52 times.

I hope this all makes sense
Rota 2023 2024 test.xlsx

Many thanks

Gary

 

[RudRud]

Thanks for provide us the sample data,

1. Change the names? For example 1 into 111, Is it all week sheets will change? Or only some selected sheets? Or Future sheet which we can select desire sheet? How can we define it?
2. Add New people? For future sheet which we can select desire sheet?
3. Remove new people? For example i deleted 1, How's the outcome? all Week deleted 1?

 

[GaryHealey]

Thanks for provide us the sample data,

1. Change the names? For example 1 into 111, Is it all week sheets will change? Or only some selected sheets? Or Future sheet which we can select desire sheet? How can we define it?
2. Add New people? For future sheet which we can select desire sheet?
3. Remove new people? For example i deleted 1, How's the outcome? all Week deleted 1?

Thank you for your fast reply, The name changes and additions and removals will be for future weeks. As there are several areas on the same sheet, it might be that I need to add a row between rows 45 and 46 and put the new details in for that person from the week that they start onwards.
The same if I remove someone that would need to be removed from the week they leave onwards.
I would like to keep the previous weeks as they are just the future weeks going forward to change.
Hope that makes sense.

 

[RudRud]

Thank you for your fast reply, The name changes and additions and removals will be for future weeks. As there are several areas on the same sheet, it might be that I need to add a row between rows 45 and 46 and put the new details in for that person from the week that they start onwards.
The same if I remove someone that would need to be removed from the week they leave onwards.
I would like to keep the previous weeks as they are just the future weeks going forward to change.
Hope that makes sense.

WEEK 35 is based on your Template Sheet right?

So you just need to add/change people, remove in template sheet? After that you run the macro then it will create a new week?

Or after you run the macro it will give you option either change current week (week 35) data (it means thatif you have additional employee then you add in template, then current week will sync) or apply new week instead?

I still figuring out your desire output that you want to deliever

 

[GaryHealey]

The way we are using the rota is to add all annual leave over the next holiday year (May to April)
I have 52 weeks on the original sheet and that has annual leave on almost every sheet.
I did think about working 2 weeks in advance but its safer to have the whole year on there.
All weeks are very similar with holidays and sickness etc meaning someone else is covering.
My thought was to create a macro to start on a specific week and end on the last sheet and then I can make slight changes to the macro each time (example add new row to 27 and enter details name round etc etc).

I did create a macro but it just failed to go to the next sheet as I was running the macro from a different workbook ( I cannot add a macro to the workbook I'm using as it is shared on a google drive)

Thank you for your patients.

 

[RudRud]

I'm still figuring out what's your plan and execution, i will reach you out again within tomorrow.

Meanwhile, I've calculated SickTaken/ A/L Taken (Automatically calculate by checking week per week) , Answer in column H and I (as double check with formula). FYR

Option Compare Text
Option Explicit
Sub test()
Dim lweek As String
Dim a As Variant
Dim i%, k%, j%
Dim ws As Worksheet
Set ws = Sheets("TEMPLATE")
'Dim dict As New Dictionary
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
ReDim b(1 To 10000, 1 To 3)
dict.CompareMode = TextCompare

lweek = Right(Sheets(Sheets.Count).Name, 2)

a = ws.Range("B2:b" & ws.Cells(Rows.Count, "B").End(xlUp).Row).Value

'Store all Column B Name (Template) in dictionary
For i = 1 To UBound(a, 1)
    If Not dict.Exists(a(i, 1)) Then
        dict.Add a(i, 1), i
    End If
Next i

'Loop through all Sheet with start of "WEEK"
For i = 4 To Worksheets.Count
    If Left(Sheets(i).Name, 4) = "WEEK" Then
        With Sheets(i)
            a = .Range("b2:G" & .Cells(Rows.Count, "b").End(xlUp).Row) 'Record to array
            For k = 1 To UBound(a, 1)
               For j = 1 To UBound(a, 2)
                 If a(k, j) = "SICK" Then
                    b(dict(a(k, 1)), 1) = a(k, 1)
                    b(dict(a(k, 1)), 2) = 1 + b(dict(a(k, 1)), 2) 'Count Sick
                 ElseIf a(k, j) = "A/L" Then
                    If b(dict(a(k, 1)), 1) = "" Then b(dict(a(k, 1)), 1) = a(k, 1)
                    b(dict(a(k, 1)), 3) = 1 + b(dict(a(k, 1)), 3) 'Count A/L
                End If
               Next j
              
            Next k
          
        End With
      
    End If
Next i

With Sheets("AL SICK")
[g2:i1000].ClearContents
.[h1].Value = "Sick Taken"
.[i1] = "A/L Taken"
.[g2].Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With

End Sub

 

[RudRud]

Hi @GaryHealey ,

For now the code is creating a new week sheet based in last sheet ( For example: When you run the macro to create WEEK36, It will copy from WEEK35 Data)

Is it part of your desire output? Let me know if you need any adjustments

Option Compare Text
Option Explicit
Sub test()
Dim lweek As String
Dim a As Variant
Dim i%, k%, j%, tblname%
Dim answer As Byte
Dim lastdate As Date
Dim ws As Worksheet
Dim ss As Range
Set ws = Sheets("TEMPLATE")
'Dim dict As New Dictionary
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
ReDim b(1 To 10000, 1 To 3)
dict.CompareMode = vbTextCompare
Application.ScreenUpdating = False

lweek = Right(Sheets(Sheets.Count).Name, 2)
lastdate = DateAdd("D", (lweek - 35) * 5, DateSerial(2023, 9, 1))

'create new sheet with values
answer = MsgBox("Do you want Create a new Week Sheet Yes" & vbNewLine & "Yes:Create new sheet", vbQuestion + vbYesNo + vbDefaultButton2, "asd")

If answer = vbYes Then
    With Sheets("WEEK " & lweek) 'Current Week
       tblname = Right(.[a2].ListObject.Name, 2) + 1
       Sheets.Add(after:=Sheets(Sheets.Count)).Name = "WEEK " & lweek + 1
       .Range("a1:j" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy Sheets("WEEK " & lweek + 1).[a1]
    End With
    
   With Sheets("WEEK " & lweek + 1) 'New Week
        .Columns("A:J").AutoFit
        .[a2].ListObject.Name = "Table" & tblname
        For Each ss In .Range("c1:g1")
            i = i + 1
             ss.Value = DateAdd("D", i, lastdate)
        Next ss
        
        For Each ss In .Range("c2:c" & .Cells(Rows.Count, "B").End(xlUp).Row)
            If InStr(ss.Value, "Manager") >= 1 Or InStr(ss.Value, "Team") >= 1 Then  'if color not grey then delete values except Team Manager/manager which is grey color
            Else
                ss.Resize(1, 6).Value = ""
            End If
    Next ss
    End With
Else
    Exit Sub
End If
   

'---------------------- AL SICK Section (Counting A/L & Sick Taken)
a = ws.Range("B2:b" & ws.Cells(Rows.Count, "B").End(xlUp).Row).Value

'Store all Column B Name (Template) in dictionary
For i = 1 To UBound(a, 1)
    If Not dict.exists(a(i, 1)) Then
        dict.Add a(i, 1), i
    End If
Next i

'Loop through all Sheet with start of "WEEK"
For i = 4 To Worksheets.Count
    If Left(Sheets(i).Name, 4) = "WEEK" Then
        With Sheets(i)
            a = .Range("b2:G" & .Cells(Rows.Count, "b").End(xlUp).Row) 'Record to array
            For k = 1 To UBound(a, 1)
               For j = 1 To UBound(a, 2)
                 If a(k, j) = "SICK" Then
                    b(dict(a(k, 1)), 1) = a(k, 1)
                    b(dict(a(k, 1)), 2) = 1 + b(dict(a(k, 1)), 2) 'Count Sick
                 ElseIf a(k, j) = "A/L" Then
                    If b(dict(a(k, 1)), 1) = "" Then b(dict(a(k, 1)), 1) = a(k, 1)
                    b(dict(a(k, 1)), 3) = 1 + b(dict(a(k, 1)), 3) 'Count A/L
                 ElseIf dict.exists(a(k, 1)) Then
                    b(dict(a(k, 1)), 1) = a(k, 1)
                End If
               Next j
              
            Next k
          
        End With
      
    End If
Next i

With Sheets("AL SICK")
[g2:i1000].ClearContents
.[h1].Value = "Sick Taken"
.[i1] = "A/L Taken"
.[g2].Resize(UBound(b, 1), UBound(b, 2)).Value = b
End With

Application.ScreenUpdating = True

End Sub

 

[GaryHealey]

Hi
Thank you for your reply, I'm really confused now as that is a lot of code.

The sheets for the A/L and sick are working okay on my original sheet, I just need a macro to update the other sheets in one hit.

This is one that I created for freezing the panes on all sheets but need one similar that will update future sheets e.g change name of B27 to John Smith or delete row 29 etc.



Sub FREEZEALL()
'
' FREEZEALL Macro
'

'
Dim Sh As Worksheet
Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Worksheets
With Sh
.Activate
Range("A3:A15").Select
End With
ActiveWindow.FreezePanes = True
Next Sh
ThisWorkbook.Worksheets(1).Activate
Application.ScreenUpdating = False
End Sub