Change Roster values

Hi Bloodywog
That's what my question presumes

I still want the code to evaluate the Start and End Dates only

Hi Bloodywog
Here are the code changes required for the new columns in RecLeave
In RecLeave Sheet Module...replace the code with this

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xHour As String
    Dim xMinute As String
    Dim xWord As String
    Select Case Target.Column
    Case Is = 1
        Application.EnableEvents = False
        Cells(Target.Row, 6) = "RL"
        Application.EnableEvents = True
    Case Is = 2, 4
        'Format Columns 2 & 4 Custom hh:mm
        'Don't enter the Colon
        Application.EnableEvents = False
        xWord = Format(Target.Value, "0000")
        xHour = Left(xWord, 2)
        xMinute = Right(xWord, 2)
        On Error Resume Next
        Target.Value = TimeValue(xHour & ":" & xMinute)
        On Error Resume Next
        Target.Offset(0, 1).Select
        Application.EnableEvents = True
    End Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Name    / Time From / Start Date / Time To / End Date / Relief / Posted OT
    Select Case Target.Column
    Case Is = 3
        g_bForm = True
        OldValue = ActiveCell.Value
        Call OpenCalendar
        Application.EnableEvents = False
        If Not g_sDate = "" Then
            ActiveCell.Value = Format(g_sDate, "mm/dd/yyyy")
        Else: ActiveCell.Value = OldValue
        End If
        Application.EnableEvents = True
    Case Is = 5
        g_bForm = True
        OldValue = ActiveCell.Value
        Call OpenCalendar
        Application.EnableEvents = False
        If Not g_sDate = "" Then
            ActiveCell.Value = Format(g_sDate, "mm/dd/yyyy")
        Else: ActiveCell.Value = OldValue
        End If
        ActiveCell.Offset(0, 1).Activate
        Application.EnableEvents = True
    End Select
End Sub

In Do_RecLeave Module replace the code with this (I've indicated the code lines I've changed/added)

Option Explicit

Sub Process_RecLeave()
    Dim myName As String
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim wrk As Workbook
    Dim myDate As Date
    Dim myRng As Range
    Dim myCol As Range
    Dim myRow As Range
    Dim Rng As Range
    Dim cel As Range
    Dim LR As Long
    Dim sYear As String
    Dim sMonth As String
    Dim x As Long
    Dim i As Long

    Set wrk = ActiveWorkbook
    Set ws1 = Sheets("Roster2012")
    Set ws2 = Sheets("RecLeave")

    With ws2
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        Set Rng = .Range("A2:A" & LR)
        For Each cel In Rng
            'Name    / Time From / Start Date / Time To / End Date / Relief / Posted OT
            If cel.Offset(0, 6).Value <> "X" Then    'changed
                x = cel.Offset(0, 4).Value - cel.Offset(0, 2).Value    'changed
                With ws1
                    myName = cel.Value
                    myDate = Format(cel.Offset(0, 2).Value, "m/dd/yyyy")    'changed
                    For i = 0 To x
                        sYear = Year(myDate)
                        sMonth = WorksheetFunction.Text(myDate, "mmm")
                        Set myRng = .Range(sMonth & "_" & sYear)

                        Set myCol = myRng.Rows(1).Find _
                                (what:=DateValue(myDate), LookIn:=xlFormulas)

                        On Error Resume Next
                        Set myRow = .Columns(1).Find(what:=myName, After:=.Cells(myRng.Rows(1).Row, 1), LookIn:=xlValues, LookAt:= _
                                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                , SearchFormat:=False)
                        On Error GoTo 0

                        Intersect(myRow.EntireRow, myCol.EntireColumn) = cel.Offset(0, 5).Value    'changed

                        myDate = myDate + 1
                    Next i
                    Application.EnableEvents = False    'added
                    cel.Offset(0, 6).Value = "X"    'changed
                    Application.EnableEvents = True    'added
                End With
            End If
        Next cel
    End With
End Sub

Please note, any date formatting changes you made to the previous code will be required here. Let me know of issues.

Hi Bloodywog
You're most welcome...an interesting project and was glad to be of help. Regarding this

do the notes in the code

As I indicated, I'll be happy to do this. I'm certain you understand much of the code so, in interest of not ballooning the file further, are there specific modules, areas, sections, lines of code you need explained? You're welcome to highlight as many as you need help with...I would like not to comment EVERY line of code

Being sure to use Code Tags (look it up in the Rules), post the code snippet(s) you'd like explained. Be sure to tell me what procedure it comes from. I'll do my best to explain. Once you're satisfied, please mark your Thread as Solved (again, look it up).

PS: I should warn you, in commenting the code I'll no doubt want to change some of the code to be more efficient/effective. Do you want that?

Hi Bloodywog
This is commented code for Sub Update_Roster(). I'd suggest putting a Break Point at this line

With ws2 'Put Break Point here and step through code (F8)

and then Step though the Code...hover over the lines so you can see what they evaluate to

Option Explicit
Sub Update_Roster()
    Dim myName As String
    Dim myName2 As String
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim wrk As Workbook
    Dim myDate As Date
    Dim myRng As Range
    Dim myCol As Range
    Dim myRow As Range
    Dim myRow2 As Range
    Dim Rng As Range
    Dim cel As Range
    Dim LR As Long
    Dim sYear As String
    Dim sMonth As String
    Dim vWks As Variant

    Set wrk = ActiveWorkbook
    Set ws1 = Sheets("Roster2012")

    For Each vWks In Array("RecLeave", "Overtime", "ShiftSwap", "SickLeave", "PersonalLeave", "MatLeave", "CleaningRoster")
        Set ws2 = Worksheets(vWks)
        With ws2
            LR = .Range("A" & .Rows.Count).End(xlUp).Row
            Set Rng = .Range("A2:A" & LR)
        End With

        With ws2 'Put Break Point here and step through code (F8)
            Select Case ws2.Name
            Case "Overtime", "ShiftSwap"
                'column headings of these two sheets are in the same order;
                'titles are different but the DATA is the same
                '                     A1          B1      C1       D1               E1
                'ShiftSwap Headings = First Name  Date    Relief   Employee Shift   Posted Roster
                'Overtime Headings =  Name        Date    Reason   Shift            Posted Roster

                For Each cel In Rng
                    'Rng is set to Set Rng = .Range("A2:A" & LR) meaning all the cells Column A
                    'from A2 to the last row in Column A

                    'Cycle through each cel in Rng: For each cel in Rng, look in Column D (cel.Offset(0, 4))
                    'that is Offset 4 columns to the right of Column A

                    'Offset is read as Offset(Rows, Columns), we want the SAME Row but a different Column
                    'ergo cel.Offset(0,4)

                    If cel.Offset(0, 4).Value <> "X" Then    'process it; if it has a value of X then
                        'skip it...it's already been processed
                        'Find the Year value of Column B (cel.Offset(0,1)
                        sYear = Year(cel.Offset(0, 1).Value)
                        
                        'Find the Month value of Column B (cel.Offset(0,1)
                        sMonth = WorksheetFunction.Text(cel.Offset(0, 1).Text, "mmm")
                        With ws1

                            'One of the first things we did on this project was to define some Named Ranges
                            'for each Calendar Block in Roster2012...look at the Named Ranges...you'll see what I mean.
                            'As you add or roll over to a New Year you'll need to do the same for the new Calendar Block(s).

                            'So we know the Month (sMonth) we're looking for and we know the Year (sYear)
                            'we're looking for.  With that information we find the Named Range we're looking for
                            'and we set myRng to that Named Range
                            Set myRng = .Range(sMonth & "_" & sYear)

                            'I'd assume you understand these next three items; if not, let me know
                            myName = cel.Value
                            myName2 = cel.Offset(0, 2).Value
                            myDate = Format(cel.Offset(0, 1).Value, "m/dd/yyyy")

                            'These next two items can be a bit abstract

                            'We want to find myDate in the First Row of the Named Range defined above
                            'as Set myRng = .Range(sMonth & "_" & sYear)

                            Set myCol = myRng.Rows(1).Find _
                                    (what:=DateValue(myDate), LookIn:=xlFormulas)

                            'Also we want to find myName in the First Column of the Named Range defined above
                            'as Set myRng = .Range(sMonth & "_" & sYear)

                            On Error Resume Next
                            Set myRow = .Columns(1).Find(what:=myName, After:=.Cells(myRng.Rows(1).Row, 1), LookIn:=xlValues, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
                            On Error GoTo 0
                            On Error Resume Next

                            'And we want to find myName2 in the First Column of the Named Range defined above
                            'as Set myRng = .Range(sMonth & "_" & sYear)
                            Set myRow2 = .Columns(1).Find(what:=myName2, After:=.Cells(myRng.Rows(1).Row, 1), LookIn:=xlValues, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
                            On Error GoTo 0

                            'Once we have these locations we find the Intersection of those locations
                            'and apply the values to those cells
                            Intersect(myRow.EntireRow, myCol.EntireColumn) = cel.Offset(0, 3).Value
                            Intersect(myRow2.EntireRow, myCol.EntireColumn) = cel.Offset(0, 3).Value
                            
                            'Mark the record as processed
                            cel.Offset(0, 4).Value = "X"
                        End With
                    End If
                Next cel
            Case "SickLeave", "PersonalLeave", "MatLeave"

                'The same logic as described above applies to these three worksheets
                'The heading DATA is the same...the same process is followed except that
                'there's only one Name not two

                For Each cel In Rng
                    If cel.Offset(0, 3).Value <> "X" Then
                        sYear = Year(cel.Offset(0, 1).Value)
                        sMonth = WorksheetFunction.Text(cel.Offset(0, 1).Text, "mmm")
                        With ws1
                            Set myRng = .Range(sMonth & "_" & sYear)
                            myName = cel.Value
                            myDate = Format(cel.Offset(0, 1).Value, "m/dd/yyyy")

                            Set myCol = myRng.Rows(1).Find _
                                    (what:=DateValue(myDate), LookIn:=xlFormulas)

                            On Error Resume Next
                            Set myRow = .Columns(1).Find(what:=myName, After:=.Cells(myRng.Rows(1).Row, 1), LookIn:=xlValues, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
                            On Error GoTo 0
                            Intersect(myRow.EntireRow, myCol.EntireColumn) = cel.Offset(0, 2).Value
                            cel.Offset(0, 3).Value = "X"
                        End With
                    End If
                Next cel
            Case "RecLeave"

                'RecLeave is a different animal and has it's own procedure

                Call Process_RecLeave
            Case "CleaningRoster"

                'Cleaning Roster follows the same logic as above but the Heading Layout
                'is different so requires different handling.  If it does not make sense
                'let me know

                Set Rng = .Range("A3:A" & LR)
                For Each cel In Rng
                    If cel.Offset(0, 4).Value <> "X" Then
                        sYear = Year(cel.Offset(0, 2).Value)
                        sMonth = WorksheetFunction.Text(cel.Offset(0, 2).Text, "mmm")
                        With ws1
                            Set myRng = .Range(sMonth & "_" & sYear)
                            myName = cel.Value
                            myName2 = cel.Offset(0, 1).Value
                            myDate = Format(cel.Offset(0, 2).Value, "m/dd/yyyy")
                            Set myCol = myRng.Rows(1).Find _
                                    (what:=DateValue(myDate), LookIn:=xlFormulas)

                            On Error Resume Next
                            Set myRow = .Columns(1).Find(what:=myName, After:=.Cells(myRng.Rows(1).Row, 1), LookIn:=xlValues, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
                            On Error GoTo 0

                            On Error Resume Next
                            Set myRow2 = .Columns(1).Find(what:=myName2, After:=.Cells(myRng.Rows(1).Row, 1), LookIn:=xlValues, LookAt:= _
                                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                                    , SearchFormat:=False)
                            On Error GoTo 0
                            Intersect(myRow.EntireRow, myCol.EntireColumn) = cel.Offset(0, 3).Value
                            On Error Resume Next
                            Intersect(myRow2.EntireRow, myCol.EntireColumn) = cel.Offset(0, 3).Value
                            On Error GoTo 0
                            cel.Offset(0, 4).Value = "X"
                        End With
                    End If
                Next cel
            End Select
        End With
    Next vWks
End Sub

Let me know if this makes sense to you.