434,960 Members | 2,232 Online
Need help? Post your question and get tips & solutions from a community of 434,960 IT Pros & Developers. It's quick & easy.

# Code to Force a Date Into a Field

 P: 36 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 May 2 '17 #1

This may get you started

Expand|Select|Wrap|Line Numbers
1. Function NthDay(Nth As Integer, XDay As Integer, XMonth As Integer, TheYear As Integer) As Date
2. '?nthday(3, 4, 2, 2012)   3rd Wed Feb 2012
3. 'Print NthDay(-2, 6, 5, 2012); last but 1; Fri; May; 2012
4. ' Sunday is day 1
5.
6.     On Error GoTo NthDay_Err
7.
8.     Dim Dt As Date
9.     Dim i As Integer, Count As Integer
10.     Dim DayOfWeek As Integer
11.     Dim LastDay As Integer
12.
13.     If Nth = 0 Or Nth > 5 Or Nth < -5 Then
14.         MsgBox "Impossible date", vbCritical
15.         Exit Function
16.     End If
17.
18.     If Nth > 0 Then
19.         i = 1
20.         Do Until Count = Nth
21.             Dt = DateValue(CStr(i) & "/" & CStr(XMonth) & "/" & CStr(TheYear))
22.             'Debug.Print Format(Dt, "medium date")
23.             DayOfWeek = Weekday(Dt)
24.             If DayOfWeek = XDay Then
25.                 Count = Count + 1
26.             End If
27.             i = i + 1
28.         Loop
29.     Else                            ' work backwards
30.         LastDay = Day(DateSerial(TheYear, XMonth + 1, 0))  ' Last day of month
31.         i = LastDay
32.         Do Until Count = -Nth       ' Nth is negative
33.             Dt = DateValue(CStr(i) & "/" & CStr(XMonth) & "/" & CStr(TheYear))
34.             'Debug.Print Format(Dt, "medium date")
35.             DayOfWeek = Weekday(Dt)
36.             If DayOfWeek = XDay Then
37.                 Count = Count + 1
38.             End If
39.             i = i - 1
40.         Loop
41.     End If
42.
43.     NthDay = Format(Dt, "Medium Date")
44.
45.     Exit Function
46.
47. NthDay_Err:
48.     If Err = 13 Then                ' Date doesn't exist
49.         Dt = 0
50.         NthDay = 0
51.     Else
52.         MsgBox "Error:" & Err & "  " & Err.Description
53.     End If
54.
55. End Function
56.
57.
Phil