loop thru days between two given dates

  • Thread starter Thread starter SF
  • Start date Start date
S

SF

Hi,

I have a table to store timesheet of employees. From the begining of the
cutoff date, I need to add EmploeeID and Date by extracting only the day and
append into the table. How can I loop and extract the day from two given
dates

SF
 
The code below will do what you want with some minor modifications. In this
case, it is looping through a range of dates to determine whether it is a
work day.

Function CalcWorkDays(dtmStart As Date, dtmEnd As Date) As Integer

Dim intTotalDays As Integer ' Counter for number of days
Dim dtmToday As Date ' To increment the date to compare

On Error GoTo CalcWorkDays_Error

intTotalDays = DateDiff("d", dtmStart, dtmEnd) + 1 'Start with total days
'Add one to include
First Day
dtmToday = dtmStart 'Initiate compare date
Do Until dtmToday > dtmEnd
If Weekday(dtmToday, vbMonday) > 5 Then 'It is Saturday or
Sunday
intTotalDays = intTotalDays - 1 'Take one day away
for Weekend day
ElseIf Not IsNull(DLookup("[Holdate]", "Holidays", _
"[Holdate] = #" & dtmToday & "#")) Then 'It is a holiday
intTotalDays = intTotalDays - 1 'Take one day away
for the Holiday
End If
dtmToday = DateAdd("d", 1, dtmToday) 'Add a day for next
compare
Loop 'Until dtmToday > dtmEnd All days have been
compared
CalcWorkDays = intTotalDays 'Return the value

CalcWorkDays_Exit:

On Error Resume Next
Exit Function

CalcWorkDays_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure CalcWorkDays of Module modDateFunctions"
GoTo CalcWorkDays_Exit
End Function
 
Back
Top