Saturday and Sunday

Hi Someone can help me


I want count between to date how many Saturday and Sunday (Or Weekend)


Thanks!


JP

Just change "date1" and "date2" to your variable names (date1 must be an earlier date than date2).

VB Code:

TmpDate = date1
    Do While TmpDate <= date2
      Select Case Weekday(TmpDate)
      Case vbSaturday, vbSunday
        NumWeekEndDays = NumWeekEndDays + 1
      End Select
      TmpDate = DateAdd("d", 1, TmpDate)
    Loop
 
    Msgbox "Weekend days: " & NumWeekEndDays & vbCr _
                 "Weekends: " & (NumWeekEndDays/2) & vbCr _
                 "Whole Weekends: " & (NumWeekEndDays\2)

VB Code:

Option Explicit
 
Private Function CountSatSun(StartDate As Date, EndDate As Date) As Long
Dim FirstSat As Date
Dim LoopDate As Date
Dim lngCount As Long
 
   'Do some error handling for StartDate and EndDate here
   
   FirstSat = DateAdd("d", -Weekday(EndDate), EndDate)
 
   'Initial count
   lngCount = 0
   LoopDate = FirstSat
   Do Until LoopDate > EndDate
      Select Case Weekday(LoopDate)
      Case vbSaturday
         If LoopDate < StartDate Then
            LoopDate = DateAdd("d", 1, LoopDate)
         Else
            lngCount = lngCount + 1
            LoopDate = DateAdd("d", 1, LoopDate)
         End If
      Case vbSunday
         If LoopDate < StartDate Then
            LoopDate = DateAdd("d", 6, LoopDate)
         Else
            lngCount = lngCount + 1
            LoopDate = DateAdd("d", 6, LoopDate)
         End If
      End Select
   Loop
   
   CountSatSun = lngCount
End Function
 
Private Sub Command1_Click()
   Text1.Text = CountSatSun(CDate(DTPicker1.Value), CDate(DTPicker2.Value))
End Sub

Oops... Didn;t know there was already an anwer.

Thanks!

I dislike the idea of looping to do something that can be done mathematically - if you need to do a lot of this Sat/Sun counting, looping will be expensive.

Here's a function I just dug up that I wrote on a mainframe in VAX-11 Basic back in 1989 - it converts a DATE to a JULIAN day value. It has hooks for standard Smithsonian day 0 vs Digital VAX day zero. I got the logic from a "programmable calculator book". It really works - you would be surprised...

Don't be alarmed by the "IF-MODIFIERS" - VAX-11 BASIC has a really great construct that allowed you to say "X=1 IF A=B"

At any rate, using these math steps to convert your two dates to julian day #'s seems like it could yield similar results without killing the processor. Once you turn your dates into day numbers, doing some division by 7 and comparing to what you know the start date is for a day should work...

VB Code:

1       function long ast_julian(dir%,year,month,day,offset,jul.date)
        option size = real double
        !       Pass    :       dir% = -1
        !                       year
        !                       month
        !                       day
        !                       julian count offset
        !       Returns :       julian date of date passed minus offset
        !               or
        !       Pass    :       dir% = -2%
        !                       julian count offset
        !                       julian date of date to convert
        !       Returns :       year
        !                       month
        !                       day
        ast_julian = 0%
        off.. = offset
        off.. = 2400000.5       if offset = -1          ! Nov 17, 1858
        off.. = 2444238.5       if offset = -2          ! Jan 01, 1980
        goto figure_cal_date    if dir% = -2%
        y = year
        m = month
        d = day
        if m <= 2 then
                y = y - 1
                m = m + 12
        end if
        if year > 1582 or (year = 1582 and (month > 10 or (month = 10 &
                                                        and day >= 15))) then
                a1 = int(y/100)
                b1 = 2 - a1 + int(a1/4)
        else
                b1 = 0
        end if
        c1 = int(365.25 * y)
        d1 = int(30.6001 * (m + 1))
        jul.date = (b1 + c1 + d1 + d + 1720994.5) - off..
        functionexit
 figure_cal_date:
        jd = jul.date + .5 + off..
        i = int(jd)
        f = jd - i
        if i > 2299160 then
                a = int((i - 1867216.25) / 36524.25)
                b = i + 1 + a - int(a/4)
        else
                b = i
        end if
        c = b + 1524
        d = int((c - 122.1) / 365.25)
        e = int(365.25 * d)
        g = int((c - e) / 30.6001)
        day = c - e + f - int(30.6001 * g)
        month = g - 1
        month = g - 13  if g > 13.5
        year = d - 4716
        year = d - 4715 if month < 2.5
        functionend

Why the loops? Won't the DateDiff function work for this? I didn't test thoroughly but this may be all you need.

VB Code:

' Shows that there are 8 Sundays between the two dates.
Debug.print DateDiff("ww", "01-Jan-2004", "28-Feb-2004", vbSunday) 
 
' Shows that there are 9 Saturdays between the two dates.
Debug.print DateDiff("ww", "01-Jan-2004", "28-Feb-2004", vbSaturday)

heh.. there's 52 saturdays and 52 sundays :p

VB Code:

'*****************************************************************************************
'* Name:            Julian
'* Author:          Mark Wilson
'* Date:            23 January 2001
'*
'* Parameters:      lDay    --> LONG     Day number
'*                  lMonth  --> LONG     Month Number
'*                  lYear   --> LONG     4 digit Year Number
'*
'*                  Ret         DOUBLE   Julian Date
'*
'* Notes:           This function converts from a standard Gregorian date to the
'*                  astronomical Julian Day Number (not Julian Date - which starts again
'*                  at the beginning of each year at 1 fom Jan 1st)
'*
'*                  This function can handle dates from 4713 BC to 4713 AD+ This should be
'*                  enough scope for most uses. It is also the fundamental Julian Day
'*                  Number Epoch from Scaliger's Initial Epoch.
'*
'*                  This algorithm has been adapted from the one that appears in
'*                  'Astronomy with your Personal Computer' by Peter Duffat Smith (2nd Ed)
'*
'* Version:         23/01/2001          Created         MW
'*****************************************************************************************
Public Function Julian(ByVal lDay As Long, ByVal lMonth As Long, ByVal lYear As Long) As Double
 
    Dim dYear As Double
    Dim dMonth As Double
    Dim dDay As Double
    
    '*********************************
    '* Algorithm place holders . . .
    '*********************************
    Dim a As Double
    Dim b As Double
    Dim c As Double
    Dim d As Double
    
    '********************************
    '* Parse VB date primitive . . .
    '********************************
    dDay = CDbl(lDay)
    dMonth = CDbl(lMonth)
    dYear = CDbl(lYear)
    
    If dMonth < 3 Then
        dMonth = dMonth + 12
        dYear = dYear - 1
    End If
    
    '**************************************************
    '* Check for Julian => Gregorian change over . . .
    '**************************************************
    
    If CLng(lYear & Format(lMonth, "00") & Format(lDay, "00")) < 15821115 Then
        b = 0
    Else
        a = Int(dYear / 100)
        b = 2 - a + Int(a / 4)
    End If
 
    c = Int(365.25 * dYear) - 694025
    
    '******************************************
    '* Further calculations for BC years . . .
    '******************************************
    If dYear < 0 Then
        c = Fix((365.25 * dYear) - 0.75) - 694025
    End If
    
    d = Int(30.6001 * (dMonth + 1))
    
    '******************************************
    '* Add it all up to get Julian Date . . .
    '******************************************
    Julian = 2415020 + b + c + d + dDay - 0.5
    Exit Function
 
End Function