INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

days in the week

days in the week

(OP)
Does anyone have a routine to calculate the number of Thursdays(or any other day) between two dates.
thanks

RE: days in the week

Here is a function that should do what you ask;

CODE

'---------------------------------------------------------------------------------------
' Procedure : finddays
' Author    : mellon
' Date      : 21-Aug-2016
' Purpose   : This routine will return a count of the number of selected weekday (EG Thursdays)
' bewteen 2 dates.
'
'parameters:
'
'Date1 ----the starting date of the time interval
'Date2 ---- the endinig date of the time interval
'WhichDay-- integer representing a Day where 1=Sun,2=Mon,3=Tue,4=Wed,5=Thur,6=Fri,7=Sat
'Showdebug --if True will display the dates that are Whichday between Date1 and Date2
'             in the immediate window
'---------------------------------------------------------------------------------------
'
Function finddays(StartDate As Date, enddate As Date, WhichDay As Integer, _
                  Optional Showdebug = False) As Integer

    Dim tmpDate As Date
    Dim NumDaysChosen As Integer
10        On Error GoTo finddays_Error

20    tmpDate = StartDate
30        Do While tmpDate <= enddate
40      tmpDate = tmpDate + 1
50      If WeekDay(tmpDate) = WhichDay Then
60          If Showdebug Then Debug.Print tmpDate
70          NumDaysChosen = NumDaysChosen + 1
80      Else
90      End If
100     i = i + 1
110       Loop
120       finddays = NumDaysChosen

130       On Error GoTo 0
140       Exit Function

finddays_Error:

150       MsgBox "Error " & err.number & " in line " & Erl & " (" & err.Description & ") in procedure finddays of Module DateCalcs_UA"
End Function 

Test routine using 7 (Saturday)

CODE

Sub testDindDays()
Dim date1 As Date: date1 = #2/23/2016#
Dim date2 As Date: date2 = #10/27/2016#
Dim dayChosen As Integer: dayChosen = 7 'where Sun = 1, Mon = 2......Sat = 7
Dim TotDays As Integer
TotDays = finddays(date1, date2, dayChosen, True)
Debug.Print "Number of Saturdays between " & date1 & " and " & date2 & " is " & TotDays
End Sub 

RE: days in the week

Or the slightly shorter:

CODE

Public Function GetSpecificDayCount(StartDate As Date, EndDate As Date, SpecificDay As VbDayOfWeek) As Long
    GetSpecificDayCount = DateDiff("ww", StartDate, EndDate, SpecificDay)
End Function 

RE: days in the week

(OP)
Thanks chaps.
Sorted by loops and datediff functions

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close