VBA Add duration to a Start Date to populate the End Date

[hotseetotsee]

I am trying to populate an End Date for my table based on the Start Date and the Duration stated by the user.
My table are as shown as below:

[TABLE="class: grid, width: 250"]
<tbody>[TR]
[TD]Task[/TD]
[TD]Start Date[/TD]
[TD]Duration
(day(s))[/TD]
[TD]End Date[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]5/12/2016[/TD]
[TD]5[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]7/12/2016[/TD]
[TD]7[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have tried to run a VBA code as follows but it returned as Run-Time Error '1004': Application defined or object-defined error

Sub PlannedEndDate()

Dim userInputDate As Date
Dim duration As Double
Dim endDate As Date


userInputDate = Range("C6" & Rows.Count).End(xlUp).Row
duration = Range("D6" & Rows.Count).End(xlUp).Row
endDate = Range("E6" & Rows.Count).End(xlUp).Row


        If duration = "" Then
            endDate = DateAdd("d", duration, userInputDate)
        Else
            endDate = userInputDate
        End If


End Sub

I am new to VBA and I really appreciate if you could help me with this. Thanks.

 

[DeBeuz]

Hi,

You are requesting rownumers to be put in userInputData, duration and endDate, since each of the filling statements ends in ".row".

Suppose your example table starts at A1.
If you want to modify task 2 (row 3)

    MyRow = 3
    userInputDate = Cells(MyRow, "B").Value
    duration = Cells(MyRow, "C").Value
    If Cells(MyRow, "D").Value <> "" Then
        endDate = DateAdd("d", duration, userInputDate)
        'Put it back on the sheet
        Cells(MyRow, "D").Value = endDate
    End If

You can also put it in a loop

Sub PlannedEndDate()

    Dim userInputDate As Date
    Dim duration As Double
    Dim endDate As Date
    
    Dim MyRow As Long
    
    'Start at row 2
    MyRow = 2
    'Loop untill column A is empty (no task)
    While Cells(MyRow, "A").Value <> ""
        'Only if not yet filled in.
        If Cells(MyRow, "D").Value = "" Then
            'Fetch info
            userInputDate = Cells(MyRow, "B").Value
            duration = Cells(MyRow, "C").Value
            endDate = DateAdd("d", duration, userInputDate)
            'Put it back on the sheet
            Cells(MyRow, "D").Value = endDate
        End If
        MyRow = MyRow + 1
    Wend
        
End Sub

Does this help you?

 

[hotseetotsee]

Hi,

You are requesting rownumers to be put in userInputData, duration and endDate, since each of the filling statements ends in ".row".

Suppose your example table starts at A1.
If you want to modify task 2 (row 3)

    MyRow = 3
    userInputDate = Cells(MyRow, "B").Value
    duration = Cells(MyRow, "C").Value
    If Cells(MyRow, "D").Value <> "" Then
        endDate = DateAdd("d", duration, userInputDate)
        'Put it back on the sheet
        Cells(MyRow, "D").Value = endDate
    End If

You can also put it in a loop

Sub PlannedEndDate()

    Dim userInputDate As Date
    Dim duration As Double
    Dim endDate As Date
    
    Dim MyRow As Long
    
    'Start at row 2
    MyRow = 2
    'Loop untill column A is empty (no task)
    While Cells(MyRow, "A").Value <> ""
        'Only if not yet filled in.
        If Cells(MyRow, "D").Value = "" Then
            'Fetch info
            userInputDate = Cells(MyRow, "B").Value
            duration = Cells(MyRow, "C").Value
            endDate = DateAdd("d", duration, userInputDate)
            'Put it back on the sheet
            Cells(MyRow, "D").Value = endDate
        End If
        MyRow = MyRow + 1
    Wend
        
End Sub

Does this help you?

Yes it does!

But how do I make it to auto-populate the end date without the process being initiated by me running the sub?

 

[DeBeuz]

You can try calling this sub on the worksheet's change event.
Whenever the sheet changes it should fire this sub.

Please wrap the call with 'Application.EnableEvents = False' and 'Application.EnableEvents = True', otherwise the changes from this code will also start firing this code and leading to a crash due to a stack overflow.

 

[hotseetotsee]

You can try calling this sub on the worksheet's change event.
Whenever the sheet changes it should fire this sub.

Please wrap the call with 'Application.EnableEvents = False' and 'Application.EnableEvents = True', otherwise the changes from this code will also start firing this code and leading to a crash due to a stack overflow.

I already did what you stated above, there's no error with my code but when I insert some data into the cell, the planned end date did not generated like it did before when the sub was ran manually. Here I put together the altered code of the sub and worksheet_change event.

Sub PlannedEndDate:

Sub PlannedEndDate()

    Dim userInputDate As Date
    Dim duration As Integer
    Dim endDate As Date


    Dim MyRow As Long


    'Start at row 6
    MyRow = 6
    'Loop untill column A is empty (no task)
    While Cells(MyRow, "A").Value <> ""
        'Only if not yet filled in.
        If Cells(MyRow, "E").Value = "" Then
            'Fetch info
            userInputDate = Cells(MyRow, "C").Value
            duration = Cells(MyRow, "D").Value
            endDate = DateAdd("d", duration, userInputDate)
            'Put it back on the sheet
            Cells(MyRow, "E").Value = endDate
        End If
        MyRow = MyRow + 1
    Wend


End Sub

Worksheet_Change:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False


    'If Not Application.Intersect(Range("$D$6"), Range(Target.Address)) Is Nothing Then
    If Target.Address = "$E$6" Then
        Call PlannedEndDate
    End If
    
Application.EnableEvents = True


End Sub

For the Worksheet_Change code, I tried to run by "If Not Application.Intersect.." method, also not succeed to auto-generate the planned end date.

I am very sorry if my code seems strange, I am new to this.

 

[DeBeuz]

Hi,

I would remove the IF-END IF construction, just call PlannedEndDate unconditionally.
It is a bit extra overhead, but the target cell changed is not just an D- or E-cell.
You can limit it to work only when duration is changed by using 'IF Left(Target.Address,2) = "$D" then ...

Do you get an error, or was it that the sub never was called at all do to the IF?
It might be causing a premature error if you fill the cells from A to D, because the change in A results into end date calculation using a not yet filled in D cell.
Just check if things do work if column A is filled in last.