Change Roster values

I need the columns to be:


Name / Time From / Start Date / Time To / End Date / Relief / Posted OT

I can say now once that is done, we can wrap this up. You have done so much already.

Then we can do the notes in the code

I'll be more that happy to do that...once we know it's working

Hi Bloodywog
Currently the code only evaluates the Start Date and the End Date; I assume you want the Start Time and End Time for posterity or you'll use it as you see fit. True?

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?