Improvements to code

[Brad]

The below code works, but is there a better way?

The logic has to allow for 5 single premium deposits to occur on any
contract anniversary. Example if the contract was issued 7/1/2008.
Deposits can be made on any anniversary after 7/1/2008. Therefore 7/1/2008,
7/1/2011, 7/1/2060 are acceptable dates and 7/15/2008, 9/1/2008 ,
11/16/2040 are unacceptable dates.


Sub Worksheet_Change(ByVal Target As Range)
Dim IMonth As Long
Dim IDay As Long

IMonth = Month(shtInput.Range("Issdate"))
IDay = Day(shtInput.Range("issdate"))
If Target.Column = 2 Then
If Month(Target.Value) <> IMonth Or Day(Target.Value) <> IDay Then
Target.Value = DateSerial(Year(Target.Value), IMonth, IDay)
MsgBox ("single premium deposits are required to be on anniveries")
End If
End If

End Sub

 

[Jim Thomlinson]

Assuming that works the way you want then I would be inclined to leave it
give or take a few minor tweaks. Where does your code evaluate the year???

Sub Worksheet_Change(ByVal Target As Range)
Dim IMonth As Long
Dim IDay As Long

If Target.Column = 2 Then 'do nothing unless column 2
with shtInput.Range("Issdate")
IMonth = Month(.value)
IDay = Day(.value)
end with
If Month(Target.Value) <> IMonth Or Day(Target.Value) <> IDay Then
application.enableevents = false 'disable events before change
Target.Value = DateSerial(Year(Target.Value), IMonth, IDay)
application.enableevents = true 'reset events
MsgBox ("single premium deposits are required to be on anniveries")
End If
End If

End Sub