Keep The Last Date Value on Term Contract

[jamesmev]

I have a process in which a contract can be written for a length of years. Example 1/1/2022-12/31/2025
On a Multi Year Price sheet I note the new price of each year depending on the length of term.
the code is written as how many years (example above = 3) So we have Yr 1, Yr2, Yr 3. Each year and date having its own new sheet. The last sheet noting the end of the contract as listed.
However if the contract is written as an end date of 12/31/2099 (& still only a 3 year term) it will create 3 sheets with the end still being 2025. I am needing the final sheet to match the final year of the contract term No matter the predetermined length (example above 3 years).

Sub Future_Year_Material()
'
' Create Future Year Materials
' JRN
'
'Call My
    Dim HardSoft As String
    
    decision = MsgBox("Please be sure to have your Multi-Year Spreadsheet in the MY Tab", vbOKCancel, "Macro Attach")
    
    If decision = "6" Then
        HardSoft = "0"
        'MsgBox "Actively"
        'End
    ElseIf decision = "7" Then
        HardSoft = "1"
        MsgBox "Action Canceled"
    End
    ElseIf decision = "2" Then
        MsgBox "Action Canceled"
    End
    End If

    Dim ws As Excel.Worksheet
    Dim lastHeaderColumn As Long
    Dim NumYears
    Dim IncreaseDate
        NumYears = InputBox(U + vbCrLf + "How Many Years Is This Contract?")
        
    NumYears = Trim(NumYears)
    If NumYears = "" Then Exit Sub
    If NumYears = " " Then Exit Sub
    
    IncreaseDate = InputBox(U + vbCrLf + "When Does The Price Increase? (MM/DD/YY)")
        
    IncreaseDate = Trim(IncreaseDate)
    If IncreaseDate = "" Then Exit Sub
    If IncreaseDate = " " Then Exit Sub
    
        
'   Clear all columns that don't have information
    
    Set ws = ActiveWorkbook.Sheets("Material")

    With ws
        'determine last filled cell in first row
        lastHeaderColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'get of all cells to the right and down and clear contents
        .Range(.Cells(1, lastHeaderColumn + 1), _
                .Cells(.Rows.Count, .Columns.Count)).ClearContents
    End With

    Dim LastRow As Long
    LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row


'   Create new sheets for future years and figure out prices
'   based on MY tab
Application.ScreenUpdating = False
    For nSheet = 1 To NumYears
        Dim DateToProcess
        ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets("Material")
        ActiveSheet.name = "Year " & nSheet & " Prices"
        Sheets("Material").Select
        Rows("1:1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Year " & nSheet & " Prices").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        xend = Selection.End(xlDown).Row
        
        Range("A1").Select
        Range("F2").Select
        ActiveCell.Formula = "=VLOOKUP('Material'!F2, 'MY'!A:Z," & nSheet & ",0)"
        Range("F2:F" & LastRow).FillDown
        Range("F:F").NumberFormat = "0.00"
        
'       Determine future year start and end dates
        
        If nSheet = 1 Then
            Range("I2").Select
            DateToProcess = DateAdd("yyyy", nSheet - 1, IncreaseDate)
            ActiveCell.Value = DateAdd("d", -1, DateToProcess)
            Range("I2:I" & LastRow).FillDown
        ElseIf nSheet > 1 Then
            Range("H2").Select
            ActiveCell.Value = DateAdd("yyyy", nSheet - 2, IncreaseDate)
            Range("H2:H" & LastRow).FillDown
            Range("I2").Select
            DateToProcess = DateAdd("yyyy", nSheet - 1, IncreaseDate)
            ActiveCell.Value = DateAdd("d", -1, DateToProcess)
            Range("I2:I" & LastRow).FillDown
        End If
        
    Next
    
    
'   Combine Materials
    Worksheets.Add(After:=Worksheets(3)).name = "Entire Contract Pricing"
        Sheets("Year 1 Prices").Select
        Rows("1:1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        ' Paste everything
        Sheets("Entire Contract Pricing").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        xend = Selection.End(xlDown).Row
    For i = 2 To NumYears
        Sheets("Year " & i & " Prices").Select
        Rows("2:2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Sheets("Entire Contract Pricing").Select
        Range("A" & xend + 1).Select
        ' Paste everything
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        xend = Selection.End(xlDown).Row
        Sheets("Year " & i & " Prices").Select
        Range("A1").Select

The rest of the code is just formatting the sheet.
Any help would be amazing.

 

[shknbk2]

At what point in the code are you entering "12/31/2099" as an end date?

Also, isn't 1/1/2022-12/31/2025 four years?

 

[jamesmev]

At what point in the code are you entering "12/31/2099" as an end date?

Also, isn't 1/1/2022-12/31/2025 four years?

The end date is entered on “material sheet” which is being referenced on the vlookup for years down. Yes. It is 4 years. However they may provide 4 years worth of price but want that final price to extend until 2099 to avoid gap if missed or extended contract
negotiations

 

[shknbk2]

Where in the code is 2025 calculated/entered when it should be 2099 for the last year? The sheet names are "Year 1 Prices", "Year 2 Prices", etc., right? Is it the DateToProcess variable that should be different when it comes to the last calculation?

 

[jamesmev]

Where in the code is 2025 calculated/entered when it should be 2099 for the last year? The sheet names are "Year 1 Prices", "Year 2 Prices", etc., right? Is it the DateToProcess variable that should be different when it comes to the last calculation?

Yes. If x years it doesn’t add +1 to the previous year instead it takes the actual inputted date.

 

[shknbk2]

Try this to replace your IF block. This is only a guess because the actual sheet/data isn't available to troubleshoot.

        If nSheet = 1 Then
            Range("I2").Select
            DateToProcess = DateAdd("yyyy", nSheet - 1, IncreaseDate)
            ActiveCell.Value = DateAdd("d", -1, DateToProcess)
            Range("I2:I" & LastRow).FillDown
        ElseIf nSheet < NumYears Then
            Range("H2").Select
            ActiveCell.Value = DateAdd("yyyy", nSheet - 2, IncreaseDate)
            Range("H2:H" & LastRow).FillDown
            Range("I2").Select
            DateToProcess = DateAdd("yyyy", nSheet - 1, IncreaseDate)
            ActiveCell.Value = DateAdd("d", -1, DateToProcess)
            Range("I2:I" & LastRow).FillDown
        Else
            Range("H2").Select
            ActiveCell.Value = IncreaseDate
            Range("H2:H" & LastRow).FillDown
            Range("I2").Select
            DateToProcess = DateAdd("yyyy", nSheet - 1, IncreaseDate)
            ActiveCell.Value = DateAdd("d", -1, DateToProcess)
            Range("I2:I" & LastRow).FillDown
        End If