Calculating Due Dates based on Frequency using VBA - vba

Question

So, right now I have this Excel sheet where there is a last revision date. I have named this column "LastRevisionDate". And then I have a column named "RevisionFrequency" . The "RevisionFrequency" contains a drop-down menu (data validation) consisting of terms, Annually, Semi-Annually, and Quarterly. And then I have a column where it states the "NextRevisionDate".
So I want to write some VBA code that would calculate the NextRevisionDate from the LastRevisionDate and the RevisionFrequency.
For example. Say in column "A" I have the RevisionFrequency to be Semi-Annually, And the last revision date was Mar-14 in column "B", then I would want the NextRevisionDate in column "C" to state September. That's basically saying that the item gets revised twice a year.
So I would want to create a macro where Column "C" is based off the RevisionFrequency and LastRevisionDate. I realize I could do this with a formula, but I have new items being added constantly so I do not want to keep copying formulas into each cell. Also for some items, they do not need revision, I would also like to have a blank cell if there is no LastRevisionDate.
So far, I have this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Sheets(1)
'For this reference of the Column Named LastCalDate I am getting an error
If Not Intersect(Target, ws.Range("LastCalDate").Value) Is Nothing Then
Dim Lastdate As Date
Dim DueDate As Variant
Dim Frequency As String
Dim R As Variant
Dim C As Variant
Dim R1 As Variant
Dim C1 As Variant
Dim R2 As Variant
Dim C2 As Variant
R = Range("LastCalDate").Row
C = Range("LastCalDate").Column
R1 = Range("CalDueDate").Row
C1 = Range("CalDueDate").Column
R2 = Range("CalFrequency").Row
C2 = Range("CalFrequency").Column
Lastdate = Cells(R, C).Value 'Last Cal Date
DueDate = Cells(R1, C1).Value 'Cal Due Date
Frequency = Cells(R2, C2)
If Frequency = "Annually" Then
DueDate = DateAdd("mmm", 12, Lastdate)
End If
If Frequency = "Semi-Annually" Then
DueDate = DateAdd("mmm", 6, Lastdate)
End If
If Frequency = "Quarterly" Then
DueDate = DateAdd("mmm", 3, Lastdate)
End If
End Sub
This is what I have so far. I'm not sure If I am doing this correctly?

Answer 1

Using the Worksheet_Change method is a great way to create the new cell value without having to copy and paste a formula. I included checks in my code as well to make sure if the date or frequency is not set, then the value is cleared out.
Private Sub Worksheet_Change(ByVal Target As Range)
' declare and set worksheet
Dim ws As Worksheet
Set ws = Sheets(1)
' declare and set default date
Dim DefaultDueDate As Date
' declare needed variables
Dim StartDate As Date
Dim Frequency As String
Dim DueDate As Date
' make sure the change only occured on the "A" or "B" column
If Target.Column = 1 Or Target.Column = 2 Then
StartDate = ws.Range("A" & Target.Row)
Frequency = ws.Range("B" & Target.Row)
' if start date does not equal the default due date and the frequency is not blank, set due date variable
If StartDate <> DefaultDueDate And Frequency <> "" Then
' add months to the provided start date
If Frequency = "Annually" Then
DueDate = DateAdd("m", 12, StartDate)
ElseIf Frequency = "Semi-Annually" Then
DueDate = DateAdd("m", 6, StartDate)
ElseIf Frequency = "Quarterly" Then
DueDate = DateAdd("m", 3, StartDate)
End If
' Make sure frequency selection is correct and due date was set
If DueDate <> DefaultDueDate Then
ws.Range("C" & Target.Row) = DueDate
End If
Else
' clear Next Revision Date when Frequency or Start Date is blank
ws.Range("C" & Target.Row) = ""
End If
End If
End Sub