Selected Answer
Please paste the code below in the 'ThisWorkbook' module of your VBA project. (Open the VB Editor by pressing Alt+F11), then save the workbook as macro-enabled. The contract dates will be updated when you next open the workbook.
Option Explicit
Private Enum Nws ' Worksheet navigation
' change the numbers here
' f.i. NwsStart = 7 changes value to column G
' missing value means "previous + 1
' therefore NwsStart is now 5 and NwsEnd is now 6
' 18 Dec 2017
NwsFirstRow = 3
NwsTerm ' = 4, identifies column D
NwsStart ' identifies column E
NwsEnd
End Enum
Private Sub Workbook_Open()
' 18 Dec 2017
Dim StartDate As Variant
Dim EndDate As Variant
Dim Term As Integer
Dim Rl As Long ' last used row
Dim R As Long
Application.ScreenUpdating = False
With Sheet1 ' change this if you use another sheet
Rl = .Cells(.Rows.Count, NwsTerm).End(xlUp).Row
For R = NwsFirstRow To Rl
EndDate = .Cells(R, NwsEnd).Value
If IsDate(EndDate) Or (Len(Trim(EndDate)) = 0) Then
If CLng(EndDate) <= CLng(Date) Then
StartDate = .Cells(R, NwsStart).Value
If IsDate(StartDate) Then
Term = Int(Val(.Cells(R, NwsTerm)))
If Term Then
If CLng(EndDate) Then StartDate = EndDate
EndDate = DateAdd("m", Term, StartDate)
.Cells(R, NwsStart).Value = StartDate
.Cells(R, NwsEnd).Value = EndDate
Else
MsgBox "No term has been set." & vbCr & _
"I can't calculate contract" & vbCr & _
"end in row " & R & ".", _
vbInformation, "Missing contract data"
End If
Else
WrongDate R, NwsStart
End If
End If
Else
WrongDate R, NwsEnd
End If
Next R
End With
Application.ScreenUpdating = False
End Sub
Private Function WrongDate(ByVal R As Long, _
ByVal Clm As Nws)
' 18 Dec 2017
Dim Typ As String
Typ = IIf(Clm = NwsStart, "start", "end")
MsgBox "Invalid " & Typ & " date in row " & R & ".", _
vbInformation, "Data could not be read"
End Function
Do me a favour and amend the caption of your question to reflect the subject of your question. Thank you.
