Code to Force a Date Into a Field

[USTRAGNU1]

Team Bytes,

I have two date fields:
App_Last
App_Next

I have a number field:
App_Frequency

I have various check boxes:
For the days of the week, 1st of month, quarter, etc.

If you would be so kind as to provide a solution for the example scenario below, I can create the rest of the combinations I need. I just need one example to get me started.

Example: If check box for Monday is checked and App_Frequency = 7, then return current date for that Monday in App-Last, and return next Monday's date in App_Next.

With all of the various combinations I can put together from an example you provide, I feel I can tailor it to where there will be little to no need for the users to manually select dates with the date picker.

Would you suggest these auto populated fields occur during form load event? Any other place?

If you have questions or require additional information, please let me know.

As always, thank you for your expertise and your great site.

Mike M

[PhilOfWalton]

This may get you started

Function NthDay(Nth As Integer, XDay As Integer, XMonth As Integer, TheYear As Integer) As Date
'?nthday(3, 4, 2, 2012)   3rd Wed Feb 2012
'Print NthDay(-2, 6, 5, 2012); last but 1; Fri; May; 2012
' Sunday is day 1
 
    On Error GoTo NthDay_Err
 
    Dim Dt As Date
    Dim i As Integer, Count As Integer
    Dim DayOfWeek As Integer
    Dim LastDay As Integer
 
    If Nth = 0 Or Nth > 5 Or Nth < -5 Then
        MsgBox "Impossible date", vbCritical
        Exit Function
    End If
 
    If Nth > 0 Then
        i = 1
        Do Until Count = Nth
            Dt = DateValue(CStr(i) & "/" & CStr(XMonth) & "/" & CStr(TheYear))
            'Debug.Print Format(Dt, "medium date")
            DayOfWeek = Weekday(Dt)
            If DayOfWeek = XDay Then
                Count = Count + 1
            End If
            i = i + 1
        Loop
    Else                            ' work backwards
        LastDay = Day(DateSerial(TheYear, XMonth + 1, 0))  ' Last day of month
        i = LastDay
        Do Until Count = -Nth       ' Nth is negative
            Dt = DateValue(CStr(i) & "/" & CStr(XMonth) & "/" & CStr(TheYear))
            'Debug.Print Format(Dt, "medium date")
            DayOfWeek = Weekday(Dt)
            If DayOfWeek = XDay Then
                Count = Count + 1
            End If
            i = i - 1
        Loop
    End If
 
    NthDay = Format(Dt, "Medium Date")
 
    Exit Function
 
NthDay_Err:
    If Err = 13 Then                ' Date doesn't exist
        Dt = 0
        NthDay = 0
    Else
        MsgBox "Error:" & Err & "  " & Err.Description
    End If
 
End Function
 
 

Phil

[USTRAGNU1]

Wow, thank you! I thought there would be less to it than this. Sorry about that!

UTS