-
Hi there
Want to know how do I return a date of the nearest friday. At the minute if I enter a start date and number of weeks it returns a date exactly that number of weeks later. That is if I enter 23/08/2000 and then 1 week, i get 30/08/2000 back which is a wednesday(I think!!) what I want returned is fridays date 01/09/2000. How do I do this?
This is my function at the minute
Public Function CalcPeriodEnd(StartDate As Variant, NoWeeks As Variant) As Variant
On Error GoTo Proc_Err
Dim NewDate As Variant
CalcPeriodEnd = 0
NewDate = DateAdd("ww", NoWeeks, StartDate)
CalcPeriodEnd = Format$(NewDate, "dd/mm/yyyy")
'just to check output
'MsgBox Format$(NewDate, "dd/mm/yyyy"), vbOKOnly
Exit Function
Proc_Err:
ErrorHandler
End Function
Thanks in advance
Gin
-
Add the following line to your code to return the Friday within the week represented by NewDate:
Code:
Public Function CalcPeriodEnd(StartDate As Variant, NoWeeks As Variant) As Variant
On Error GoTo Proc_Err
Dim NewDate As Variant
CalcPeriodEnd = 0
NewDate = DateAdd("ww", NoWeeks, StartDate)
NewDate = DateAdd("d", vbFriday - Weekday(NewDate), NewDate)
CalcPeriodEnd = Format$(NewDate, "dd/mm/yyyy")
'just to check output
'MsgBox Format$(NewDate, "dd/mm/yyyy"), vbOKOnly
Exit Function
Proc_Err:
ErrorHandler
End Function
-
-
If I add a monday as a start date, 04/09/2000 and add a week, it gives the end date as 15/09/2000 and not 08/09/2000 which would be the date I want to appear. If the start date is a monday I want the end date to be the first friday, any other start day and it can go into the next week. Any ideas?? Does this make sense?
-
If the start date is always going to be a Monday, then to get to that Friday, just do a DateAdd for 4 days:
EndDate = DateAdd("d", 4, StartDate)
Is that what you're looking for, or am I missing something?
-
The problem is that any date can be the start date, at the minute if the start date is a monday the end date is always a friday after the one I want returned. That is it seems to add an additional week!
Hope this clears up any confusion!
Thanx for all the help
Gin
-
I think if we modify your function as follows, it will do what you want:
Code:
Public Function CalcPeriodEnd(StartDate As Variant, NoWeeks As Variant) As Variant
On Error GoTo Proc_Err
Dim NewDate As Variant
Dim intNumWks As Integer
CalcPeriodEnd = 0
If Weekday(StartDate) = vbMonday Then
intNumWks = NoWeeks - 1
Else
intNumWks = NoWeeks
End If
NewDate = DateAdd("ww", intNumWks, StartDate)
NewDate = DateAdd("d", vbFriday - Weekday(NewDate), NewDate)
CalcPeriodEnd = Format$(NewDate, "dd/mm/yyyy")
'just to check output
'MsgBox Format$(NewDate, "dd/mm/yyyy"), vbOKOnly
Exit Function
Proc_Err:
ErrorHandler
End Function
