I have a database with a user entry form that allows the end user to create an order with an effective date. The effective date is the 1st of the next month (current month +1) if the creation date is before the 15th, or the 1st of the following month (current month +2) if the creation date is the 15th or later. I would like the VBA code to determine if the created date is before or after the 15th, run a comparison to make sure the effective date is either 1 or 2 months ahead as appropriate, and show an exception message if the effective date input is not valid.
My original code worked up until last week, when we had an unexpected outage and the database shut down. Now it throws up the exception message regardless of the effective date input:
Private Sub EffDue_AfterUpdate()
If Format(Me.PCCreated, "DD") < 15 Then
Dim CurrentDate As Date
Dim IntervalType As String
Dim Number As Integer
Dim EffDate As Date
IntervalType = "m"
Number = 1
CurrentDate = Me.PCCreated
EffDate = DateAdd(IntervalType, Number, CurrentDate)
ElseIf Format(EffDate, "MM") < Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") > Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") = Format(Me.EffDue, "MM") Then
Me.Text99 = ""
End If
If Format(Me.PCCreated, "DD") >= 15 Then
IntervalType = "m"
Number = 2
CurrentDate = Me.PCCreated
DateAdd(IntervalType, Number, CurrentDate) = EffDate
ElseIf Format(EffDate, "MM") < Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") > Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") = Format(Me.EffDue, "MM") Then
Me.Text99 = ""
End If
If Format(Me.EffDue, "DD") > 1 Then
Me.Text99 = "The effective due date should be the 1st"
End If
End Sub
My latest revision correctly identifies if the created date is before or after the 15th, but it doesn't correctly calculate the effective date:
Private Sub EffDue_AfterUpdate()
Dim CurrentDay As Integer
Dim EffDate As Date
Dim CurrentMonth As Integer
Dim EffMonth As Integer
CurrentDay = DatePart("d", Me.PCCreated)
CurrentMonth = DatePart("m", Me.PCCreated)
If CurrentDay >= 15 Then
EffDate = DateAdd("M", 2, Me.PCCreated)
EffMonth = DatePart("m", EffDate)
ElseIf CurrentMonth > EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth < EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth = EffMonth Then
Me.Text95 = ""
End If
If CurrentDay < 15 Then
EffDate = DateAdd("M", 1, Me.PCCreated)
EffMonth = DatePart("m", EffDate)
ElseIf CurrentMonth > EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth < EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth = EffMonth Then
Me.Text95 = ""
End If
If Day(Me.EffDue) > 1 Then
Me.Text95 = "The effective due date should be the 1st"
End If
End Sub
I'm sure I'm overlooking something simple and I'll kick myself once someone points it out. Any help would be much appreciated!
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…