Creating a dynamic rota.....is this even possible?

Hello

I'm wondering if I'm trying to do the impossible, or if any of you guys can help direct me?

I have a worksheet that has Employee Name and a designated Shift (for example EmployeeA must work Monday am; Employee B must work Friday pm etc for a total of 70 employees). This worksheet also contains their phone numbers, working team allocations etc and is a really simple sheet where users can come in and make amendments to the teams or designated shifts etc.

what I then need, is for excel to magically take this information and put it into a calendar for me - so another sheet, or workbook if that's better, I need the dates as columns, with a row for each employee, and where there is a specific shift for that employee (as determined by the first worksheet), transfer that information into the appropriate cell on the calendar sheet.

Does that make any sense? Help!!

Thanks so much x

That sounds doable. Do you have an example workbook? Saves us guessing & guessing wrong

Good thinking batman.......
I'll upload one now.

Right, I've added a mock spreadsheet (I think!). The first worksheet is an example of how the data will be held. The second worksheet is how (roughly) I want it to look. I've manually entered the data, but that's where I need the help to make it do it by itself!! I've still lots of to learn with excel - I'm kind of hitting the ground running a little bit with this!!

Thanks so much x

Your file is password protected, so we can't open it.

Pete

You know I said lots to learn.......
Password hannah1310
Clearly I'll now go and change the password on the proper one.
Sorry....***must drink more coffee***

It's password protected

Yup realised that....sorry.....password hannah1310

I'm just looking at this now - I think what you've done may just work!!
will keep playing and will let you know. Thank you so much!!

Blowing kisses already?? lol

Where do the employees make the changes, is there any particular column on employee information sheet they update?

Management would make changes to the front worksheet, i.e. Change employee1 from a Monday AM to a Thursday PM.
Employees themselves would have limited access to the calendar (or a duplicate) to put other shift requests in.

Thanks so much for the help - it's appreciated!!

I've made a start, but it's getting late here & time for bed
I'll have a look tomorrow & post a file for you to try

Amazing thank you

Try this & see if it's what you're after

It only works up to Employee7 because that's all there is on the 4WeeklyOverallTemplate worksheet.
There's no buttons to press as it's a worksheet change macro & will trigger when something changes in columns D, E or F.
Adjust anything in columns D,E or F on EmployeeInformation worksheet and the macro will enter the new data on 4WeeklyOverallTemplate worksheet.
The dropbox link is for you to get the file. I can't upload any attachments to this site & haven't been able to for months.
To see the code right click EmployeeInformation worksheet tab & click view code
Cheers

https://www.dropbox.com/s/1842tyxiww...8472.xlsm?dl=0

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo TheExit

Dim SessionDayRng As Range, AmPmRng As Range, SessionNameRng As Range
Dim TplDayRange As Range, rCell As Range
Dim sEmployeeName1 As String, sSessionDay As String, sAMPM As String, sSessionName As String
Dim Lrow As Long, A As Long, RowNum As Long, Luc As Long

'   Find last used row in column 1 Sheet1
    Lrow = Me.Columns(1).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlPart, Searchorder:=xlByRows, searchdirection:=xlPrevious, _
            MatchCase:=False, searchformat:=False).Row

'   Find last used column in row 2 on Sheet2
    Luc = Sheet2.Rows(2).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlPart, Searchorder:=xlByColumns, searchdirection:=xlPrevious, _
            MatchCase:=False, searchformat:=False).Column

'   Set the 3 ranges to detect changes in
    Set SessionNameRng = Me.Range("D3:D" & Lrow)
    Set SessionDayRng = Me.Range("E3:E" & Lrow)
    Set AmPmRng = Me.Range("F3:F" & Lrow)

'Stop

If Not Intersect(Target, SessionDayRng) Is Nothing Or _
    Not Intersect(Target, SessionNameRng) Is Nothing Or _
    Not Intersect(Target, AmPmRng) Is Nothing Then

    Application.EnableEvents = False

'   Populate variables
    sEmployeeName1 = Me.Cells(Target.Row, 1)
    sSessionName = Me.Cells(Target.Row, 4)
    sSessionDay = Me.Cells(Target.Row, 5)
    sAMPM = Me.Cells(Target.Row, 6)

'   Find row number employee is on in Sheet2
    A = Sheet2.Columns(2).Find(What:=sEmployeeName1, LookIn:=xlValues, _
            LookAt:=xlWhole, Searchorder:=xlByRows, searchdirection:=xlNext, _
            MatchCase:=False, searchformat:=False).Row
    
'   Set day range on Sheet2 (4WeeklyOverallTemplate)
    Set TplDayRange = Sheet2.Range(Sheet2.Cells(2, 4), Sheet2.Cells(2, Luc))

'   Select the correct row for entering details in
    Select Case UCase(sAMPM)

        Case Is = "AM": RowNum = A

        Case Is = "PM": RowNum = A + 1

        Case Is = "NIGHT": RowNum = A + 2

        Case Is = "CALL": RowNum = A + 3

    End Select

'   Delete any previous meetings etc of the employee
    Sheet2.Range(Sheet2.Cells(A, 4), Sheet2.Cells(A + 3, Luc)).ClearContents

'   Enter the employees new or altered data on Sheet1 (EmployeeInformation)
'   on to sheet 2 (4WeeklyOverallTemplate)
    For Each rCell In TplDayRange
        If UCase(rCell) = UCase(sSessionDay) Then Sheet2.Cells(RowNum, rCell.Column) = sSessionName
    Next rCell

Else

    GoTo TheExit

End If

TheExit:
Application.EnableEvents = True
Exit Sub

End Sub

Thank you so much - I'll look first thing after school/nursery run - it's 003" here. I've just had a look at the code and it looks like that may just do it. Thanks so much - will look and let yoh know

Originally Posted by Philb1

Try this & see if it's what you're after

It only works up to Employee7 because that's all there is on the 4WeeklyOverallTemplate worksheet.
There's no buttons to press as it's a worksheet change macro & will trigger when something changes in columns D, E or F.
Adjust anything in columns D,E or F on EmployeeInformation worksheet and the macro will enter the new data on 4WeeklyOverallTemplate worksheet.
The dropbox link is for you to get the file. I can't upload any attachments to this site & haven't been able to for months.
To see the code right click EmployeeInformation worksheet tab & click view code
Cheers

https://www.dropbox.com/s/1842tyxiww...8472.xlsm?dl=0

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo TheExit

Dim SessionDayRng As Range, AmPmRng As Range, SessionNameRng As Range
Dim TplDayRange As Range, rCell As Range
Dim sEmployeeName1 As String, sSessionDay As String, sAMPM As String, sSessionName As String
Dim Lrow As Long, A As Long, RowNum As Long, Luc As Long

'   Find last used row in column 1 Sheet1
    Lrow = Me.Columns(1).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlPart, Searchorder:=xlByRows, searchdirection:=xlPrevious, _
            MatchCase:=False, searchformat:=False).Row

'   Find last used column in row 2 on Sheet2
    Luc = Sheet2.Rows(2).Find(What:="*", LookIn:=xlValues, _
            LookAt:=xlPart, Searchorder:=xlByColumns, searchdirection:=xlPrevious, _
            MatchCase:=False, searchformat:=False).Column

'   Set the 3 ranges to detect changes in
    Set SessionNameRng = Me.Range("D3:D" & Lrow)
    Set SessionDayRng = Me.Range("E3:E" & Lrow)
    Set AmPmRng = Me.Range("F3:F" & Lrow)

'Stop

If Not Intersect(Target, SessionDayRng) Is Nothing Or _
    Not Intersect(Target, SessionNameRng) Is Nothing Or _
    Not Intersect(Target, AmPmRng) Is Nothing Then

    Application.EnableEvents = False

'   Populate variables
    sEmployeeName1 = Me.Cells(Target.Row, 1)
    sSessionName = Me.Cells(Target.Row, 4)
    sSessionDay = Me.Cells(Target.Row, 5)
    sAMPM = Me.Cells(Target.Row, 6)

'   Find row number employee is on in Sheet2
    A = Sheet2.Columns(2).Find(What:=sEmployeeName1, LookIn:=xlValues, _
            LookAt:=xlWhole, Searchorder:=xlByRows, searchdirection:=xlNext, _
            MatchCase:=False, searchformat:=False).Row
    
'   Set day range on Sheet2 (4WeeklyOverallTemplate)
    Set TplDayRange = Sheet2.Range(Sheet2.Cells(2, 4), Sheet2.Cells(2, Luc))

'   Select the correct row for entering details in
    Select Case UCase(sAMPM)

        Case Is = "AM": RowNum = A

        Case Is = "PM": RowNum = A + 1

        Case Is = "NIGHT": RowNum = A + 2

        Case Is = "CALL": RowNum = A + 3

    End Select

'   Delete any previous meetings etc of the employee
    Sheet2.Range(Sheet2.Cells(A, 4), Sheet2.Cells(A + 3, Luc)).ClearContents

'   Enter the employees new or altered data on Sheet1 (EmployeeInformation)
'   on to sheet 2 (4WeeklyOverallTemplate)
    For Each rCell In TplDayRange
        If UCase(rCell) = UCase(sSessionDay) Then Sheet2.Cells(RowNum, rCell.Column) = sSessionName
    Next rCell

Else

    GoTo TheExit

End If

TheExit:
Application.EnableEvents = True
Exit Sub

End Sub