# VBA date calculations based on new input date

#### olivespickles

##### New Member
Hi all,

I am working on a macro to complement something I have already written, where the user inputs the required finish date, and the macro automatically calculates start dates for 5 project phases that need to happen before the finish date. Each phase takes 1 month, therefore phase 1 starts 5 months before the finish date, phase 2 starts 4 months before the finish date, etc.

i am working on an extra function where I want the user to be able to change the start date of one project phase or more (within the cell), and this macro will automatically calculate the subsequent start dates of the later phases according to the new date. Eg. the original finish date was 31 May 2021 and the expected phase 1 start date was 01 Jan 2021 (5 months before finish), but phase 1 started late and the actual start date is now 01 Feb 2021, which means that all the other dates will be 1 month later than originally calculated. This is the code I have so far:

VBA Code:
``````'old date variables
Sheets("X").Cells(outputrow, 5) = finish
Sheets("X").Cells(outputrow, 6) = start_phase1
Sheets("X").Cells(outputrow, 9) = start_phase2
Sheets("X").Cells(outputrow, 15) = start_phase3
Sheets("X").Cells(outputrow, 18) = start_phase4
Sheets("X").Cells(outputrow, 21) = start_phase5

'Date recalculations

finish = CDate(finish)
start_phase1 = CDate(start_phase1)
start_phase2 = CDate(start_phase2)
start_phase3 = CDate(start_phase3)
start_phase4 = CDate(start_phase4)
start_phase5 = CDate(start_phase5)

'conditions

If start_phase1 = finish - 150 Then
start_phase1 = start_phase1

Else
start_phase2 = start_phase1 + 30
start_phase3 = start_phase2 + 30
start_phase4 = start_phase3 + 30
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase2 = finish - 120 Then
start_phase2 = start_phase2

Else
start_phase3 = start_phase2 + 30
start_phase4 = start_phase3 + 30
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase3 = finish - 90 Then
start_phase3 = start_phase3

Else
start_phase4 = start_phase3 + 30
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase4 = finish - 60 Then
start_phase4 = start_phase4

Else
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase5 = finish - 30 Then
start_phase5 = start_phase5

Else
finish = start_phase5 + 30

End If``````

Currently I am having a problem where Excel defaults all my year dates to 1900 and doesn't recalculate new dates based on the "actual" start dates I input. I am not sure where I'm going wrong? Would appreciate some advice on this, thanks!

### Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

#### JonXL

##### Active Member
How are you calling all this? As is, you haven't actually posted any functions or subs - just bits of code. So it'll be hard to troubleshoot where you are having problems.

• olivespickles

#### olivespickles

##### New Member
How are you calling all this? As is, you haven't actually posted any functions or subs - just bits of code. So it'll be hard to troubleshoot where you are having problems.
This is everything I have so far:

VBA Code:
``````Sub Deadlines()

Dim finish, start_phase1, start_phase2, start_phase3, start_phase4, start_phase5 As Date
Dim outputrow As Integer

outputrow = 2
While Not Sheets("X").Cells(outputrow, 1) = ""
outputrow = outputrow + 1
Wend

'old date variables
Sheets("X").Cells(outputrow, 5) = finish
Sheets("X").Cells(outputrow, 6) = start_phase1
Sheets("X").Cells(outputrow, 9) = start_phase2
Sheets("X").Cells(outputrow, 15) = start_phase3
Sheets("X").Cells(outputrow, 18) = start_phase4
Sheets("X").Cells(outputrow, 21) = start_phase5

'Date recalculations

finish = CDate(finish)
start_phase1 = CDate(start_phase1)
start_phase2 = CDate(start_phase2)
start_phase3 = CDate(start_phase3)
start_phase4 = CDate(start_phase4)
start_phase5 = CDate(start_phase5)

'conditions

If start_phase1 = finish - 150 Then
start_phase1 = start_phase1

Else
start_phase2 = start_phase1 + 30
start_phase3 = start_phase2 + 30
start_phase4 = start_phase3 + 30
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase2 = finish - 120 Then
start_phase2 = start_phase2

Else
start_phase3 = start_phase2 + 30
start_phase4 = start_phase3 + 30
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase3 = finish - 90 Then
start_phase3 = start_phase3

Else
start_phase4 = start_phase3 + 30
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase4 = finish - 60 Then
start_phase4 = start_phase4

Else
start_phase5 = start_phase4 + 30
finish = start_phase5 + 30

End If

If start_phase5 = finish - 30 Then
start_phase5 = start_phase5

Else
finish = start_phase5 + 30

End If

'populate NEW unit op start dates on next row

Sheets("X").Cells(outputrow, 21) = start_phase5
Sheets("X").Cells(outputrow, 18) = start_phase4
Sheets("X").Cells(outputrow, 15) = start_phase3
Sheets("X").Cells(outputrow, 9) = start_phase2
Sheets("X").Cells(outputrow, 5) =start_phase1
Sheets("X").Cells(outputrow, 5) = finish

End Sub``````

#### JonXL

##### Active Member
To get this to fire when you update one of your cells, you will need to put it in (or call it from) a `Worksheet_Change()` event. The code for this goes in the worksheet (not a stand-alone module).

It would look something like this (using it to call your sub):

VBA Code:
``````Private Sub Worksheet_Change (ByVal Target As Range)
Application.EnableEvents = False
End If
Application.EnableEvents = True
End Sub``````

To write something that will work for your specific situation, we'd need to know what cells your users are updating that you expect to trigger this script.

(Note, I haven't reviewed your actual code to see if it will do what you want it to do; just focusing on getting it to run when it's supposed to at the moment.)

Replies
6
Views
42
Replies
13
Views
141
Replies
5
Views
289
Replies
0
Views
109
Replies
1
Views
89

### Forum statistics

1,129,930
Messages
5,639,051
Members
417,066
Latest member
rhenman ### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?    1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option. Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com". Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back