By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,497 Members | 2,127 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,497 IT Pros & Developers. It's quick & easy.

Code to Force a Date Into a Field

USTRAGNU1
P: 29
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

✓ answered by PhilOfWalton

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

Share this Question
Share on Google+
2 Replies


PhilOfWalton
Expert 100+
P: 1,430
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
May 2 '17 #2

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

UTS
May 2 '17 #3

Post your reply

Sign in to post your reply or Sign up for a free account.