Code using Dates

[Guest]

Given a startDate, and a finishDate, how can I:

a) Find out the number of days in each month between those dates. ie
28/09/06 to 02/11/06 would have 3 days in September, 31 in October, and 2 in
November.

b) Loop for each month. Ie, with the above dates, the loop would run 3 times
(Sept, Oct, Nov).

c) Alternative to all the above. Count the number of days between the two
dates. Loop between the two dates, when the month increments by 1, calculate
the proportion of days counted against the total number of days.

Thanks,

Dave

 

[Guest]

Paste the following into a module and run "TestCount":

Private Sub TestCount()
Call CountingDays(#9/28/2006#, #11/2/2006#)
End Sub

Private Sub CountingDays(dteStart As Date, dteStop As Date)

Dim dteWork As Date
Dim rayDates(365) As Date
Dim rayAnswer(11, 1) As String
Dim intAnsRow As Integer
Dim intAnsCol As Integer
Dim intAnsCnt As Integer
Dim intRayCnt As Integer
Dim intMonth As Integer
Dim intDays As Integer
Dim intDayCnt As Integer
Dim strMonth As String
Dim strAnswer As String

intRayCnt = 0
intDays = DateDiff("d", dteStart, dteStop)
dteWork = dteStart

Do While dteWork < dteStop
rayDates(intRayCnt) = dteWork
intRayCnt = intRayCnt + 1
dteWork = DateAdd("d", 1, dteWork)
Loop

rayDates(intRayCnt) = dteWork
intAnsRow = 0

For intRayCnt = 0 To (intDays + 1)
intMonth = DatePart("m", rayDates(intRayCnt))
strMonth = Format(rayDates(intRayCnt), "mmmm")
Do While DatePart("m", rayDates(intRayCnt)) = intMonth
intDayCnt = intDayCnt + 1
intRayCnt = intRayCnt + 1
Loop
rayAnswer(intAnsRow, 0) = strMonth
rayAnswer(intAnsRow, 1) = intDayCnt
intAnsRow = intAnsRow + 1
intDayCnt = 1
Next

For intAnsCnt = 0 To intAnsRow - 1

strAnswer = _
strAnswer & _
rayAnswer(intAnsCnt, 0) & _
Space(15 - Len(rayAnswer(intAnsCnt, 0))) & _
rayAnswer(intAnsCnt, 1) & _
vbCrLf

Next

MsgBox strAnswer, vbInformation, "The Answer:"

dteWork = Empty
rayDates(365) = Empty
rayAnswer(11, 1) = ""
intAnsRow = Empty
intAnsCol = Empty
intAnsCnt = Empty
intRayCnt = Empty
intMonth = Empty
intDays = Empty
intDayCnt = Empty
strMonth = ""
strAnswer = ""

End Sub