VBA date calculations based on new input date

[olivespickles]

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:

'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!

 

[JonXL]

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]

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:

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]

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).

Worksheet.Change event (Excel)

Office VBA reference topic

docs.microsoft.com

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

Private Sub Worksheet_Change (ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "A1" Then
        Call Deadline
    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.)