Setting Txtboxes to NULL

[Derek Wittman]

Good afternoon,
I have up to and including 5 dates that I need to compare to one another. I
was thinking I had a few options on how to make this work. I thought I could
compare date 2 with date 1, then date 3 with date 2, and so on, but this will
not catch my users if they make date 3 = date 1...

So, I need to actually somehow do all 10 iterations (5 Combinations, taken 2
at a time for all you statisticians out there!). Unfortunately, my code is a
bit on the messy side, aside from Doug Steele's assistance earlier. Aside
from checking the dates against each other, my number of dates to compare can
be from 1 to 5, and there are times when a date must be after an associate's
anniversary date. (on 3 years, 8 years, 15 years, and 20 years, associates
get an additional vacation week, but only AFTER their anniversary date).
Associates are also permitted (dateadd function) to take a vacation week in
the week where their anniversary falls.

It's an extremely (for me, anyway) ugly bit of code, so please watch the
wordwraps as well. I do appreciate any assistance that may come my way.

Private Sub cmdSubmit_Click()
Dim datecheck As Date
Dim datecount As Integer
Dim nullcount As Integer
Dim nullchecker As Integer
nullcount = 0
datecount = 0
datecheck = DateAdd("d", -6, Month(DLookup("[AssocDOH]", "tblAssociates",
"[AssocID#] = Forms!frmMain.txtID")) & "/" & Day(DLookup("[AssocDOH]",
"tblAssociates", "[AssocID#] = Forms!frmMain.txtID")) & "/06")
If Len(Forms!frmVacEntry.txt1stweek & "") > 0 Then
nullcount = nullcount + 1
If datecheck < DateValue(txt1stweek) Then datecount = datecount + 1
End If
If Len(Forms!frmVacEntry.txt2ndweek & "") > 0 Then
nullcount = nullcount + 1
If datecheck < DateValue(txt2ndweek) Then datecount = datecount + 1
End If
If Len(Forms!frmVacEntry.txt3rdweek & "") > 0 Then
nullcount = nullcount + 1
If datecheck < DateValue(txt3rdweek) Then datecount = datecount + 1
End If
If Len(Forms!frmVacEntry.txt4thweek & "") > 0 Then
nullcount = nullcount + 1
If datecheck < DateValue(txt4thweek) Then datecount = datecount + 1
End If
If Len(Forms!frmVacEntry.txt5thweek & "") > 0 Then
nullcount = nullcount + 1
If datecheck < DateValue(txt5thweek) Then datecount = datecount + 1
End If
nullchecker = earnedweeks() - nullcount
Select Case nullchecker
Case 0
If Nz(txtAddlwks, 0) > 0 Then MsgBox "Checking your anniversary
date...", , "You're almost done!"
If txtAddlwks = 1 Then
If datecount = 0 Then MsgBox "You must select 1 of your weeks
after your anniversary date", vbOKOnly, "Try again"
If datecount = 1 Then
MsgBox "Congratulations! Your vacation will be scheduled.",
vbOKOnly, "Congrats!"
MsgBox "You will not be guaranteed your scheduled time off if
you bid into a new shift or section", , "DISCLAIMER"
End If
End If
Case 1
MsgBox "You have 1 more week to use. Please complete the form",
vbOKOnly, "Try Again"
If txtAddlwks = 1 Then
If datecount = 0 Then MsgBox "You must select 1 of your weeks after
your anniversary date", vbOKOnly, "Try again"
End If

Case Else
MsgBox "You have " & nullchecker & " more weeks to use. Please
complete the form", vbOKOnly, "Try Again"
If txtAddlwks = 1 Then
If datecount = 0 Then MsgBox "You must select 1 of your weeks after
your anniversary date", vbOKOnly, "Try again"
End If

End Select

End Sub


Thank you very much!
DW

 

[SteveS]

Derek,

To check the dates, I used an array. Load the dates into the array, sort it,
then step thru checking the current date to the next date.

To do this I had to change the names of the controls on the form. The names I
used are:

txtweek1, txtweek2, ..., txtweek5

It is easier to loop thru the controls.

Hopefully, this will get you moving again.

I've test the code down to this line.

"nullchecker = earnedweeks() - nullcount"

You didn't provide the code for the function "earnedweeks()"

Below is the modified code... watch for line wrap



Private Sub cmdSubmit_Click()
Dim datecheck As Date
Dim datecount As Integer
Dim nullcount As Integer
Dim nullchecker As Integer

'added
Dim a() As Date, temp As Variant
Dim vDups As Boolean
Dim vDOH As Date
Dim anniversaryDT As Date
Dim i As Integer, C As Integer, j As Integer
ReDim a(5)

nullcount = 0
datecount = 0

vDups = 0

'do lookup once
vDOH = DLookup("[AssocDOH]", "tblAssociates", "[AssocID#] = " &
Forms!frmVacEntry.txtID)

' instead of hard coding the year ("/06")
' use Year(Date)
'calc this year anniversary date
anniversaryDT = DateSerial(Year(Date), Month(vDOH), Day(vDOH))

datecheck = DateAdd("d", -6, anniversaryDT)

'------ start new code--------------
' check for duplicate vac dates
'----------------------------

'count of vac weeks
C = 0

'load array with valid vac dates from form
For i = 1 To 5
If IsDate(Me("txtweek" & i)) Then
C = C + 1
a(C) = Me("txtweek" & (i))
End If
Next i

'ReDim Preserve a(C)

' bubble sort
For i = C - 1 To 1 Step -1
For j = 1 To i
If a(j) > a(j + 1) Then
temp = a(j + 1)
a(j + 1) = a(j)
a(j) = temp
End If
Next
Next

'Debug.Print "sorted"
'For i = 1 To C
' Debug.Print i; a(i)
'Next i

'**********************************
' comment out the next two FOR loops if
' you don't want to write the sorted dates
' back to the controls on the form

'clear the controls on the form
' and set the backcolor to white
For i = 1 To 5
Me("txtweek" & i) = Null
Me("txtweek" & i).BackColor = vbWhite
Next i

'put the sorted dates back in the controls
For i = 1 To UBound(a)
Me("txtweek" & i) = a(i)
Next i
'**********************************


' now check for duplicate dates
' if duplicate, set the backcolor to yellow
For i = 1 To UBound(a) - 1
If a(i) = a(i + 1) Then
'comment out the next line
' if you don't want to change BG color
Me("txtweek" & i + 1).BackColor = vbYellow
vDups = True
End If
Next i

If vDups Then
MsgBox "You have entered duplicate vacation weeks! " & vbCrLf & vbCrLf &
"Please change the hi-lited week(s)."
End If
'------------end new code--------------------

If IsDate(Me.txtweek1) Then
If datecheck < DateValue(Me.txtweek1) Then
datecount = datecount + 1
End If
Else
nullcount = nullcount + 1
End If

If IsDate(Me.txtweek2 & "") Then
If datecheck < DateValue(Me.txtweek2) Then
datecount = datecount + 1
End If
Else
nullcount = nullcount + 1
End If

If IsDate(Me.txtweek3) Then
If datecheck < DateValue(Me.txtweek3) Then
datecount = datecount + 1
End If
Else
nullcount = nullcount + 1
End If

If IsDate(Me.txtweek4) Then
If datecheck < DateValue(Me.txtweek4) Then
datecount = datecount + 1
End If
Else
nullcount = nullcount + 1
End If

If IsDate(Me.txtweek5) Then
If datecheck < DateValue(Me.txtweek5) Then
datecount = datecount + 1
End If
Else
nullcount = nullcount + 1
End If

nullchecker = earnedweeks() - nullcount

Select Case nullchecker
Case 0
If Nz(txtAddlwks, 0) > 0 Then MsgBox "Checking your anniversary
date...", , "You're almost done!"
If txtAddlwks = 1 Then
If datecount = 0 Then MsgBox "You must select 1 of your weeks
after your anniversary date", vbOKOnly, "Try again"
If datecount = 1 Then
MsgBox "Congratulations! Your vacation will be scheduled.",
vbOKOnly, "Congrats!"
MsgBox "You will not be guaranteed your scheduled time off if
you bid into a new shift or section", , "DISCLAIMER"
End If
End If
Case 1
MsgBox "You have 1 more week to use. Please complete the form",
vbOKOnly, "Try Again"
If txtAddlwks = 1 Then
If datecount = 0 Then MsgBox "You must select 1 of your weeks
after your anniversary date", vbOKOnly, "Try again"
End If

Case Else
MsgBox "You have " & nullchecker & " more weeks to use. Please
complete the form", vbOKOnly, "Try Again"
If txtAddlwks = 1 Then
If datecount = 0 Then MsgBox "You must select 1 of your weeks
after your anniversary date", vbOKOnly, "Try again"
End If

End Select

End Sub