New Table According Num of Years

J

Jose Fonyat

New member
Joined
Aug 30, 2017
Messages
13
Reaction score
0
Points
0
Location
Brazil
Excel Version(s)
Microsoft 365 Apps Versao 2007
Let me know if someone could give me a help in a specific solution that I am facing.I have the following table with 5 columns:

NumberContractCustomerNameStartDateEndDateTotalYearsTotalPointsAmount
1Richard05.Jan.1404.Jan.17036000030000
2Carl05.Feb.1504.Jan.20 05125000100000
3Steve05.Mar.1604.Feb.2105200000150000

My goal is to achieve another table with many lines (records)

NumberContractCustomerNameStartDateEndDateNumOfYearTotalPointsAmount
1Richard05.Jan.1404.Jan.15120.00010.000
1Richard05.Jan.1504.Jan.16220.00010.000
1Richard05.Jan.1604.Jan.17320.00010.000
2Carl05.Feb.1504.Jan.16125.00020.000
2Carl05.Feb.1604.Jan.17225.00020.000
2Carl05.Feb.1704.Jan.18325.00020.000
2Carl05.Feb.1804.Jan.19425.00020.000
2Carl05.Feb.1904.Jan.20525.00020.000
3Steve05.Mar.1604.Mar.17140.00030.000
3...................

Note that for each year of the contract I split in one line (record) and set the Total Points and Amount for each year.

As the Start Year, End Year and NumOfYyear changes accordingly.Is there a code suitable for this challenge?Any help would be appreciated.Best Regards
05.Feb.15
 
Code: 
Public Sub Reformat()
Dim lastrow As Long
Dim numYears As Long
Dim i As Long
    Application.ScreenUpdating = False
    
    With ActiveSheet
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For i = lastrow To 2 Step -1
        
            numYears = .Cells(i, "E").Value
            .Rows(i + 1).Resize(numYears - 1).Insert
            .Cells(i, "A").Resize(, 7).Copy .Cells(i + 1, "A").Resize(numYears - 1)
            With .Cells(i, "E").Resize(numYears)
            
                .Formula = "=ROW(A1)"
                .Value = .Value
            End With
            .Cells(i, "F").Resize(numYears) = .Cells(i, "F").Value / numYears
            .Cells(i, "G").Resize(numYears) = .Cells(i, "G").Value / numYears
        Next i
    End With
    
    Application.ScreenUpdating = True
End Sub
 
Thanks a lot Bob!
Your help was precious!

Please let me know if you can support a bit more:

1. Create the new table in a new worksheet
2. Adjust the values in the collumns StartDate and EndDate to show the exact periods.

Best Regards
Jose Ricardo
 
I don't get your dates. In the second example, there are gaps between the first new date and the second new row date.
 
Code: 
Sub M_snb()
     sn = Cells(1).CurrentRegion
     
     For j = 2 To UBound(sn)
        c00 = c00 & Replace(String(sn(j, 5), ","), ",", "," & j)
        sn(j, 6) = sn(j, 6) / sn(j, 5)
        sn(j, 7) = sn(j, 7) / sn(j, 5)
     Next
     sp = Application.Index(sn, Application.Transpose(Split("1" & c00, ",")), [transpose(row(1:7))])
     
     For j = 2 To UBound(sp)
        If sp(j, 2) <> c01 Then
           c01 = sp(j, 2)
           y = 1
        End If
        sp(j, 3) = DateAdd("yyyy", y - 1, Replace(Replace(sp(j, 3), ".", "-"), "Mar", "mrt"))
        sp(j, 4) = DateAdd("yyyy", 1, sp(j, 3))
        sp(j, 5) = y
        y = y + 1
    Next
    
    Cells(20, 1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub
 
You must log in or register to reply here.
Back
Top