Auto populate multiple entries to calendar base on

Question

I'm trying to write a VBA to find the date in a summary sheet and populate the data to a calendar for employee vacation tracking.

The data in Summary page looks like this

Month Employee Vacation Type Start Date End Date Time Feb Carl Half Day PM 2/26/2015 2/26/2015
Feb Hurness Half Day PM 2/26/2015 2/26/2015
Feb Edna Half Day AM 1/18/2016 2/26/2015

I wrote the code below to populate single line. I'd like to know how to populate multiple entries to calendat base on difference of start and end date

Thanks in advance for any help!

Sub AddToCalendar()

Dim R As Range
Dim lastRow As Long
Dim startDate As Integer
Dim Employee As String
Dim Reason As String
Dim Time As String
Dim sSheet As String

'locate the info in the last row of the Summary sheet
lastRow = Sheets("Summary").Cells(Rows.Count, 4).End(xlUp).row
Employee = Sheets("Summary").Cells(lastRow, 2).Value
Reason = Sheets("Summary").Cells(lastRow, 3).Value
Time = Sheets("Summary").Cells(lastRow, 6).Value


'active the worksheet of relevant month
sSheet = Sheets("Summary").Cells(lastRow, 1).Value
Worksheets(sSheet).Activate

'locate the cell of specific date and enter data
startDate = Day(Sheets("Summary").Cells(lastRow, 4).Value) 
endDate = Day(Sheets("Summary").Cells(lastRow, 5).Value)

With Sheets(sSheet)
    If startDate = endDate Then
        Set R = .Range("A1:H58").Find(startDate)
         If Not R Is Nothing Then
             Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
         End If

     Else
         Do Until startDate = endDate
             startDate = startDate + 1
             Set R = .Range("A1:H58").Find(startDate)
             If Not R Is Nothing Then
                 Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
             End If
         Loop

     End If

 End With

End Sub

Answer 1

I tried to add the code to skip weekends, but I'm a bit comfused witht the logic here. Here's what I've done, could you have a look and see what's wrong please? Thanks a lot!

  For i = 1 To TotalDaysOff
            With Sheets(sSheet)
                Set R = .Range("A1:H58").Find(startDate + (i - 2))
                If Not R Is Nothing Then
                    Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time

                    If skipWeekend >= 6 Then
                        Sheets(sSheet).Cells(R.row + 1, R.Column).Value = ""
                    Else
                        Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
                    End If

                End If

Answer 2

To enter multiple lines on the summary sheet based on a date range (different start date and end date), your best bet is to first figure out how many days off the employee took. This is a fairly simple arithmetic calculation, such as:

TotalDaysOff = EndDate - StartDate + 1

[NOTE: We have to add 1 to the formula to get the correct number of days. For example 2/26/2015 - 2/26-2015 would equal 0, but we know it's actually 1].

Once we have the TotalDaysOff calculated, we can create a simple loop to populate each row, such as:

If TotalDaysOff = 1 then
    With Sheets(sSheet)
        Set R = .Range("A1:H58").Find(startDate)
        If Not R Is Nothing Then
            Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee     & " " & Reason & " " & Time
        End If

    End With
Else
    for i = 1 to TotalDaysOff
        With Sheets(sSheet)
            Set R = .Range("A1:H58").Find(startDate + (i - 1))
            If Not R Is Nothing Then
                Sheets(sSheet).Cells(R.row + 1, R.Column).Value = Employee & " " & Reason & " " & Time
            End If

        End With

    Next i
End If

Does this work for you?