6 months worth of date intervals based on initial date and 2 fields of days of week

Ok...i already have a system in place but it's not exactly what i'm looking for.

ok here's my code:

-------------------------------------------------start of code---------------------------------------
Option Compare Database
Option Explicit

Private Sub InsertDates(StartDate, EndDate, Interval, StartDate2, EndDate2, Interval2)
'delete the contents of the table first
'CurrentDb.Execute "delete * from tblDates"
Dim iSql As String, schDate, schDate2
Dim intPatientid As String, ptid
Do Until schDate >= EndDate
ptid = Me.cmdpatient
    If Not IsDate(schDate) Then
    iSql = "insert into tblDates(dDate,patientid,ddate2) "
    iSql = iSql & "Values(#" & StartDate & "#," & ptid & ",#" & StartDate2 & "#)"
    CurrentDb.Execute iSql
    schDate = DateAdd("d", Interval, StartDate)
    schDate2 = DateAdd("d", Interval2, StartDate2)
   
    Else
    iSql = "insert into tblDates(dDate,patientid,ddate2) "
    iSql = iSql & "Values(#" & schDate & "#," & ptid & ",#" & schDate2 & "#)"
    CurrentDb.Execute iSql
    schDate = DateAdd("d", Interval, schDate)
    schDate2 = DateAdd("d", Interval2, schDate2)
       

   
    End If
Loop
End Sub

Function GetDate(sDay As String) As Date
Dim i As Integer, j As Integer
j = Weekday(Date)
Select Case sDay
    Case "Sunday"
        i = 1
        GetDate = Date - (j - i)
    Case "Monday"
        i = 2
        GetDate = Date - (j - i)
       
    Case "Tuesday"
        i = 3
        GetDate = Date - (j - i)
    Case "Wednesday"
        i = 4
        GetDate = Date - (j - i)
    Case "Thursday"
        i = 5
        GetDate = Date - (j - i)
    Case "Friday"
        i = 6
         GetDate = Date - (j - i)
   Case "Saturday"
        i = 7
        GetDate = Date - (j - i)
End Select
End Function

Private Sub Command3_Click()
DoCmd.OpenTable "tbldates", acViewNormal
End Sub

Private Sub Command4_Click()
'MsgBox Weekday(Date)
Dim msg As String
Dim response As Integer
Me.ComboDay.SetFocus
'MsgBox Me.Comboday2.Value
Me.cmdpatient.SetFocus
msg = "You are about to give " & Me.cmdpatient.Text & " his/her dates for 6 months"
msg = msg & "are you sure you want to continue?"
If MsgBox(msg, vbQuestion + vbYesNo) = vbNo Then
response = acDataErrContinue
       Else
Dim vDate As Date, i As Integer
Dim vdate2 As Date
vDate = GetDate(Me.ComboDay)
vdate2 = GetDate(Me.Comboday2)
Call InsertDates(vDate, DateAdd("m", 6, vDate), 7, vdate2, DateAdd("m", 6, vdate2), 7)

MsgBox "Command Complete.", vbCritical
 End If
End Sub

-------------------------------------------------end of code---------------------------------------

The problem is that i have a need for an initial date to be calculated in.  
So in the "getdate" function the date used is the weekday(date) but i need it to be the initial startdate....

I don't know how to go about this.

chris
candgAsked:
Who is Participating?
 
bobHackerCommented:
Hi Chris,

I have a DB zipped up and ready to send.
What is your email address?

thank you
Bob
0
 
nico5038Commented:
Did you try to add the initial  date as additional parameter like:

Function GetDate(sDay As String, iDate as Date) As Date
Dim i As Integer, j As Integer
j = Weekday(iDate)
Select Case sDay
    Case "Sunday"
        i = 1
        GetDate = iDate - (j - i)
    Case "Monday"
etc.

Nic;o)
0
 
bobHackerCommented:

Hi

This is just a variation on what you have already strated and     nico's comment
but it allows setting the weekend date  or any data as a startdate
hope this helps

Option Compare Database
Option Explicit

Public Function getWeekEndingDate() As Date

Dim dayOfWeek As Integer
Dim dteWeekEndingDate As Date
Dim DayOfWeekEnding As Integer

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set the day that the week ends here
'
'sun 1  , mon 2, tue 3, wed 4, thu 5, fri 6, sat 7
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DayOfWeekEnding = 6   '<<<<<<<<<<<<<<<<<<<<< SET THIS # to 7 if saturday becomes end of week...

'how it works
'if week ending day of week = 6(fri) and today dow=1 (6-1=+5)  5=number of days to add to current day nbr to get to day 6
'if week ending day of week = 6(fri) and today dow=2 (6-2=+4)  4=number of days to add to current day nbr to get to day 6
'if week ending day of week = 6(fri) and today dow=3 (6-3=+3)  3=number of days to add to current day nbr to get to day 6
'if week ending day of week = 6(fri) and today dow=4 (6-4=+2)  2=number of days to add to current day nbr to get to day 6
'if week ending day of week = 6(fri) and today dow=5 (6-5=+1)  1=number of days to add to current day nbr to get to day 6
'if week ending day of week = 6(fri) and today dow=6 (6-6=0)   0=number of days to add to current day nbr to get to day 6
'if week ending day of week = 6(fri) and today dow=7 (6)       6=number of days to add to get to next week day 6


dayOfWeek = Weekday(Date)
'MsgBox "Day of week is: " & dayOfWeek
'MsgBox "Day of weekEnding is: " & dayOfWeek

Select Case dayOfWeek
       Case 1 'sun
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding - 1), Date)
       Case 2 'mon
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding - 2), Date)
       Case 3 'tue
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding - 3), Date)
       Case 4 'wed
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding - 4), Date)
       Case 5 'thu
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding - 5), Date)
       Case 6 'fri
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding - 6), Date)
       Case 7 'sat
            dteWeekEndingDate = DateAdd("d", (DayOfWeekEnding), Date)
       Case Else
            dteWeekEndingDate = Date
End Select

'return
getWeekEndingDate = dteWeekEndingDate

End Function

=========================================================

Public Function getWkEnd7() As Date

      getWkEnd7 = getWeekEndingDate

End Function

Public Function getWkBeg7() As Date

      getWkBeg7 = DateAdd("d", (-6), getWeekEndingDate)

End Function

Public Function getWkEnd14() As Date

      getWkEnd14 = DateAdd("d", (-7), getWeekEndingDate)

End Function

Public Function getWkBeg14() As Date

      getWkBeg14 = DateAdd("d", (-13), getWeekEndingDate)

End Function

Public Function getWkEnd21() As Date

      getWkEnd21 = DateAdd("d", (-14), getWeekEndingDate)

End Function

Public Function getWkBeg21() As Date

      getWkBeg21 = DateAdd("d", (-20), getWeekEndingDate)

End Function

Public Function getWkEnd28() As Date

      getWkEnd28 = DateAdd("d", (-21), getWeekEndingDate)

End Function

Public Function getWkBeg28() As Date

      getWkBeg28 = DateAdd("d", (-27), getWeekEndingDate)

End Function

Public Function getWkEnd35() As Date

      getWkEnd35 = DateAdd("d", (-28), getWeekEndingDate)

End Function

Public Function getWkBeg35() As Date

      getWkBeg35 = DateAdd("d", (-34), getWeekEndingDate)

End Function

Public Function getWkEnd42() As Date

      getWkEnd42 = DateAdd("d", (-35), getWeekEndingDate)

End Function

Public Function getWkBeg42() As Date

      getWkBeg42 = DateAdd("d", (-41), getWeekEndingDate)

End Function
 
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
candgAuthor Commented:
bob is there anyway you can put that into a db an send it to me?

deftoned at swbell dot net
0
 
bobHackerCommented:

Hi,

I am not sure how to do send you a file on here.

BUT...

You could just open up Access and then a new module, and copy and paste the code as is.

Sound OK?
 
thanks
0
 
candgAuthor Commented:
Well...you just email a zipped db......with that code.....so i can see what your saying.

Chris
p.s. points increased to 500
0
 
candgAuthor Commented:
deftoned at swbell dot net
0
 
candgAuthor Commented:
bob  hacker what's going on.
0
 
bobHackerCommented:
Hi Chris,

I am sorry.
I got messages from expert exchange via email, and they fell into my spam filter.
I will send you an Access 2002 db with the code in a module. From there you can
run each of the procedures to see if this can be of use to you for your project.

Thank you
Bob
0
 
candgAuthor Commented:
Bob how would i go about calling that in a form?

chris
0
 
bobHackerCommented:
Hi Chris,

You could create a test form with a button just for testing how to call a function.

 ...in the click event for the button do something like this :

============================================================
Private Sub Command0_Click()

Dim theDate As Date

theDate = getWeekEndingDate()     ' this is the call to execute the function
                                                   ' and put the week ending date into this local
                                                   ' variable called theDate
                                   
MsgBox "The week ending date from the function is: " & theDate, vbInformation, "The Date"
                         
                                                                              'this is the variable with the date
                                                                              'that will show up in the message box
 
End Sub
=============================================================
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.