CODEWITHSUNDEEP
vbaexcelformat
adit123
adit123

Reputation: 117

Calculating Due Dates based on Frequency using VBA

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?

Upvotes: 2

Views: 1897

Answers (2)

NeelsK
NeelsK

Reputation: 11

Changed code as follows and it is working.

Private Sub Worksheet_Change(ByVal Target As Range)

' declare and set worksheet
Dim ws As Worksheet
Set ws = Sheets(2)

' declare and set default date
Dim DefaultDueDate As Date

' declare needed variables
Dim StartDate As Date
Dim PeriodType As String
Dim DueDate As Date
Dim PeriodValue As Long


' make sure the change only occured on the "A" or "B" column
If Target.Column = 6 Or Target.Column = 7 Or Target.Column = 8 Then

    StartDate = ws.Range("F" & Target.Row)
    PeriodType = ws.Range("G" & Target.Row)
    PeriodValue = ws.Range("H" & 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 PeriodType <> "" Then

        ' add months to the provided start date
        If PeriodType = "Year" Then
            DueDate = DateAdd("YYYY", PeriodValue, StartDate)
        ElseIf PeriodType = "Quarter" Then
            DueDate = DateAdd("q", PeriodValue, StartDate)
        ElseIf PeriodType = "Month" Then
            DueDate = DateAdd("m", PeriodValue, StartDate)
        ElseIf PeriodType = "Week" Then
            DueDate = DateAdd("ww", PeriodValue, StartDate)
        ElseIf PeriodType = "Day" Then
            DueDate = DateAdd("d", PeriodValue, StartDate)
        End If

        ' Make sure frequency selection is correct and due date was set
        If DueDate <> DefaultDueDate Then
            ws.Range("K" & Target.Row) = DueDate
        End If

    Else

        ' clear Next Revision Date when Frequency or Start Date is blank
        ws.Range("K" & Target.Row) = ""

    End If

End If

End Sub

Upvotes: 0

Dan
Dan

Reputation: 419

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

Upvotes: 1

Related Questions