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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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)
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
 
candgAuthor Commented:
bob is there anyway you can put that into a db an send it to me?

deftoned at swbell dot net
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

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
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
bobHackerCommented:
Hi Chris,

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

thank you
Bob

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
candgAuthor Commented:
deftoned at swbell dot net
candgAuthor Commented:
bob  hacker what's going on.
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
candgAuthor Commented:
Bob how would i go about calling that in a form?

chris
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
=============================================================
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.