Entering Dates in Excel based off parameters using VBA - excel

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 consisting of terms, "Annually", "Bi-Annually"(2 times in a year), "Semi-Annually", and "Quarterly". And then I have a column where it states the "NextRevisionDate". So I want to create a 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 "Bi-annually" And the last revision date was Mar-14 in column "B", then I would want the NextRevisionDate in column "C" to state Mar,Sep .Thats 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 updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Sheets(1)
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

Answer 1

“Am I just overcomplicating my code?”
That is the wrong question. The first question is not “What can I do?” but “What do my users want?”
If you start by saying “I can produce wooden clogs”, you may never learn they want soft slippers. You may not be able to produce soft slippers but you can probably produce something a lot better than wooden clogs if know it is required. Start with the design of the ideal product then cut it down to what is practical.
From your description, I visualise something like this:
You may have many other columns and these three columns may be in different positions; it does not matter, we will restrict ourselves these columns for now.
It sounds to me as though you have two requirements and an issue:
You have a worksheet where the values in the Next Revision Date column may be unreliable or missing. You require a macro that will run down the existing worksheet and enter correct values into the Next Revision Date column.
You have a requirement to set the values in the Next Revision Date column automatically as new rows are added of existing Revision Frequencies and Last Revision Dates are amended. This could be achieved by running macro 1 or using the Worksheet Change event, as you suggest. There may be other approaches but I will not address this requirement.
If you look at the last three rows of my example worksheet, you will notice the day of the month in the Next Revision Date column is not the same as that in the Last Revision Date. This is because I converted the value in the Frequency column to 3, 6 or 12 and added that number of months to the Last Revision Date. In the last three rows the new month does not have as many days as the old and the VBA function has, for example, converted 30 February to 2 March. Is this the effect you require? I have included code to bring the date back to the “correct” month. Often the most difficult task in macro design is identifying all these exceptions and specifying how they are to be handled.
I will only consider macro 1 first since you can use it for both requirements while you are design and implementing macro 2. If you run into problems with macro 2, ask a new question. You can ask as many questions as you like – providing they are good questions – but they should only be one issue per question.
You need a macro that will step down every row of the worksheet. If you are using an online tutorial or you have bought a book on Excel VBA, you may find a suitable example there. If you are using neither an online tutorial nor a book, please start. It will not take long to master the basics of Excel VBA and the time spent learning the basics will quickly repay itself. Trying to search the web for code when you do not know the basics is very difficult.
If your tutorial/book does not tell you how to step down every row of the worksheet, try searching SO for “[excel-vba] find last row of worksheet”. There are lots of variations of this question so you should have no difficulty in finding something suitable. You do not have to do so on this occasion because I show you how below but I believe this is the best way of using this site. Break your requirement down into little steps and then search for a question relevant to each step.
Below is a simple macro 1. Study my code and come back with questions if necessary. However, the more you can understand on your own, the faster you will develop.
Welcome to the joys of programming.
Option Explicit
' Using constants for values that may change makes your code easier to
' understand and easier to maintain.
Const ColFrequency As Long = 1
Const ColLastRevisionDate As Long = 2
Const ColNextRevisionDate As Long = 3
Const RowDataFirst As Long = 2
Sub FixNextRevisionDate()
Dim DateLastCrnt As Date
Dim DateNextCrnt As Date
Dim NumMonthsToStep As Long
Dim RowCrnt As Long
Dim RowLast As Long
' Replace "Data" with the name of your worksheet
With Worksheets("Data")
' This is the most popular method of finding the last row but it will
' not work in every situation. I believe it is appropriate for your
' current requirement but suggest you look for questions that describe
' other methods and which explain why they might be better.
RowLast = .Cells(Rows.Count, ColFrequency).End(xlUp).Row
For RowCrnt = RowDataFirst To RowLast
' Convert Frequency to 3, 6 or 12
' I have used the LCase function to allow for inconsistent use of
' upper and lower case
Select Case LCase(.Cells(RowCrnt, ColFrequency).Value)
Case "annually"
NumMonthsToStep = 12
Case "bi-annually"
NumMonthsToStep = 6
Case "semi-annually"
NumMonthsToStep = 6
Case "quarterly"
NumMonthsToStep = 3
Case Else
' Unknown frequency. never assume the worksheet is correct
' if an error will cause your macro to fail.
' This is an easy way to highlight faulty values for user
' attention.
With .Cells(RowCrnt, ColFrequency)
.Interior.Color = RGB(255, 0, 0)
NumMonthsToStep = 0
End With
End Select
If NumMonthsToStep <> 0 Then
' Had valid frequency
If IsDate(.Cells(RowCrnt, ColLastRevisionDate).Value) Then
' Value in Last Revision Date column is a date
DateLastCrnt = .Cells(RowCrnt, ColLastRevisionDate).Value
' Calculate next date by adding NumMonthsToStep
DateNextCrnt = DateSerial(Year(DateLastCrnt), _
Month(DateLastCrnt) + NumMonthsToStep, _
Day(DateLastCrnt))
' You may not want this but it shows how to do it if you do
If Day(DateNextCrnt) < Day(DateLastCrnt) Then
DateNextCrnt = DateSerial(Year(DateNextCrnt), _
Month(DateNextCrnt), _
0)
End If
With .Cells(RowCrnt, ColNextRevisionDate)
.Value = DateNextCrnt
' Replace with date format of your choice
.NumberFormat = "d mmm yy"
End With
Else
' The Last Revision Date is not a date
With .Cells(RowCrnt, ColLastRevisionDate)
.Interior.Color = RGB(255, 0, 0)
End With
End If
End If
Next
End With
End Sub