Split a date according to periods

[apt]

Split a date according to periods
Hello everyone,

I want to enter dates in a table when there is a period in another, the two terminals of the global date will be broken or split to create short periods and add other times to fill the time intervals empty.

For example, I have these four periods of dates entered in my table:

01/08/2013 – 31/08/2013
05/08/2013 – 05/08/2013
12/08/2013 – 19/08/2013
15/08/2013 – 17/08/2013

The VBA code will return this table:

01/08/2013 – 04/08/2013
05/08/2013 – 05/08/2013
06/08/2013 – 11/08/2013
12/08/2013 – 14/08/2013
15/08/2013 – 17/08/2013
18/08/2013 – 19/08/2013
20/08/2013 – 31/08/2013

Thanks.

 

[NARAYANK991]

Hi ,

Can you confirm whether the data can be sorted , or is it not possible to sort it , and whatever order it is in will have to be retained ?

Narayan

 

[apt]

Hi NARAYANK991,

Indeed, the dates will be sorted from oldest to newest.

 

[apt]

Hi,

One approach to give a try?

 

[Marc L]

Hi !

Seems to be a cross posting with this one : Fractionner une date selon des périodes saisies …

With a new Workbook I copy your 4 lines x 2 columns example table above starting in F2 cell,
F1:G1 are deserved to the columns titles …

I obtain your 7 lines result table on the same columns with this code (easy to adapt) :

Sub NewSpecialNoobDemo()
    Dim FR As Date, GP As Date
 
    Application.ScreenUpdating = False
 
    With [F1].CurrentRegion
        .Sort [G1], xlAscending, Header:=xlYes
        R& = .Rows.Count
    End With
 
    Do Until R < 3
        FR = Cells(R, 6).Value
        GP = Cells(R - 1, 7).Value + 1
 
        If FR < Cells(R - 1, 6).Value Then
            L& = R - 1
 
            Do Until L = 2 Or Cells(L - 1, 6).Value < FR
                L = L - 1
            Loop
 
            Cells(R, 6).Value = GP
            [F1].CurrentRegion.Rows(L).Insert xlShiftDown
            Cells(L, 6).Value = FR
            Cells(L, 7).Value = Cells(L + 1, 6).Value - 1
 
        ElseIf FR > GP Then
            [F1].CurrentRegion.Rows(R).Insert xlShiftDown
            Cells(R, 6).Value = GP
            Cells(R, 7).Value = FR - 1
 
        Else
            R = R - 1
        End If
    Loop
 
    Application.ScreenUpdating = True
End Sub

As I already said on the other forum, don't forget to well explain your needs
for those who can't (or don't want for obvious security reason) upload a file …

 

[apt]

Hello Marc-L

The reproduction of the result is not quite right.

Because each agent to own these periods.

The dates will be split apart for each agent.

The result obtained by the advanced code treats all dates as it was for each agent.

You can ask me for more clarification on the subject.

 

[Marc L]

For example, I have these four periods of dates entered in my table:

01/08/2013 – 31/08/2013
05/08/2013 – 05/08/2013
12/08/2013 – 19/08/2013
15/08/2013 – 17/08/2013

The VBA code will return this table:

01/08/2013 – 04/08/2013
05/08/2013 – 05/08/2013
06/08/2013 – 11/08/2013
12/08/2013 – 14/08/2013
15/08/2013 – 17/08/2013
18/08/2013 – 19/08/2013
20/08/2013 – 31/08/2013

Thanks.

As writen, the code is based only upon that example and works like a charm ‼

Easy to adapt …