VBA date calculations based on new input date

olivespickles

New Member
Joined
Apr 6, 2021
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
  2. Web
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

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

JonXL

Active Member
Joined
Feb 5, 2018
Messages
459
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

New Member
Joined
Apr 6, 2021
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
  2. Web
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
Joined
Feb 5, 2018
Messages
459
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
    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.)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,791
Messages
5,638,340
Members
417,021
Latest member
moon miner

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Top