VBA code to loop through date and time range and split into smaller chuncks

[th081]

Hello

In sheet1 i have data in column A through I as below:

Excel 2016 (Mac) 32 bit
	A	B	C	D	E	F	G	H	I
1	name	Start	Stop	Data A	Data B	Point A	Point B	Point C	Point D
2	XYZ	01/09/16 04:15:00	02/09/16 13:25:00	1234	6789	01/09/16 04:35:00	01/09/16 04:43:00	02/09/16 12:27:00	02/09/16 12:39:00
3
Sheet1

i want to loop through the rows and breakdown a single row into mutiple rows, these will be based on half hourly intervals based on the start and stop date/time in Column B and C but will also take into account the date and times in Column F to I (which will always fall into the start and stop range).

So the row above would be broken down as below (with sheet2 as the outout):

Excel 2016 (Mac) 32 bit
	A	B	C	D	E	F	G
4		Start	Stop	Data A	Data B
5	XYZ	01/09/16 04:15:00	01/09/16 04:30:00	1234	6789
6	XYZ	01/09/16 04:30:00	01/09/16 04:35:00	1234	6789	values in point A and point B used here
7	XYZ	01/09/16 04:35:00	01/09/16 04:43:00	1234	6789
8	XYZ	01/09/16 04:43:00	01/09/16 05:00:00	1234	6789
9	XYZ	01/09/16 05:00:00	01/09/16 05:30:00	1234	6789
10	XYZ	01/09/16 05:30:00	01/09/16 06:00:00	1234	6789
11	XYZ	01/09/16 06:00:00	01/09/16 06:30:00	1234	6789
12	XYZ	01/09/16 06:30:00	01/09/16 07:00:00	1234	6789
13	XYZ	01/09/16 07:00:00	01/09/16 07:30:00	1234	6789	Large block of half hours hidden
14	XYZ	01/09/16 07:30:00	01/09/16 08:00:00	1234	6789
15	XYZ	01/09/16 08:00:00	01/09/16 08:30:00	1234	6789
16	XYZ	01/09/16 08:30:00	01/09/16 09:00:00	1234	6789
17	XYZ	01/09/16 09:00:00	01/09/16 09:30:00	1234	6789
68	XYZ	02/09/16 10:30:00	02/09/16 11:00:00	1234	6789
69	XYZ	02/09/16 11:00:00	02/09/16 11:30:00	1234	6789
70	XYZ	02/09/16 11:30:00	02/09/16 12:00:00	1234	6789
71	XYZ	02/09/16 12:00:00	02/09/16 12:27:00	1234	6789	values in point C and point D used here
72	XYZ	02/09/16 12:27:00	02/09/16 12:30:00	1234	6789
73	XYZ	02/09/16 12:30:00	02/09/16 12:39:00	1234	6789
74	XYZ	02/09/16 12:39:00	02/09/16 13:00:00	1234	6789
75	XYZ	02/09/16 13:00:00	02/09/16 13:30:00	1234	6789
76	XYZ	02/09/16 13:30:00	02/09/16 14:00:00	1234	6789
77	XYZ	02/09/16 14:00:00	02/09/16 14:30:00	1234	6789
78	XYZ	02/09/16 14:30:00	02/09/16 15:00:00	1234	6789
79	XYZ	02/09/16 15:00:00	02/09/16 15:30:00	1234	6789
80	XYZ	02/09/16 15:30:00	02/09/16 16:00:00	1234	6789
81	XYZ	02/09/16 16:00:00	02/09/16 16:25:00	1234	6789
Sheet1

So the original 1 line is broken into 77 lines.

Can anyone help. I am struggling.

 

[th081]

I am using Excel in windows even though the above is posted from a Mac

 

[bellman101]

Will sheet 1 contain multiple rows, so after the 77 rows on sheet 2 for XYZ, would it then need to show another n rows for the next set, or will it only be splitting out 1 item at a time?

Are you looking to achieve this with just formulae, or are you open to VBA as well?

 

[th081]

Hi

Sheet 1 will contain lots of rows so yes after the first line is split it would add n rows for the next row to sheet 2. I was looking to achive this with VBA because i thought that would be easier than formulas.

Regards

 

[bellman101]

ha, yes you're right there! if it was just the 1 row to split then formulae shouldn't be too heavy, but if there are multiple, then VBA will be much simpler. Just heading home but should be able to help in half an hour or so if you're still struggling. I have some stuff similar to this in a rota project I have been working on.

 

[bellman101]

Hey There,

This should do it:

Sub SplitDateTimes()

    Dim varStt As Double
    Dim varEnd As Double
    Dim varPtA As Double
    Dim varPtB As Double
    Dim varPtC As Double
    Dim varPtD As Double
    Dim varTme As Double
    
    Set shtSrc = Sheets("Sheet1")
    Set shtTrg = Sheets("Sheet2")
    Set varRng = shtSrc.Range("A2").Resize(Application.WorksheetFunction.CountA(shtSrc.Range("A:A")) - 1)
    
    n = 2
    i = 5
    With shtTrg
    For Each forCELL In varRng.Cells
        
        varStt = forCELL.Offset(0, 1)
        varSttB = varStt
        varEnd = forCELL.Offset(0, 2)
        varPtA = forCELL.Offset(0, 5)
        varPtB = forCELL.Offset(0, 6)
        varPtC = forCELL.Offset(0, 7)
        varPtD = forCELL.Offset(0, 8)
        varTme = (Hour(varStt) / 24) + (Int(Minute(varStt) / 30) * 30) + (1 / 48)
        varRw = i
        
        Do While Int(varStt) + varTme < varPtA
            .Cells(i, 2) = varSttB
            .Cells(i, 3) = Int(varStt) + varTme
            varSttB = Int(varStt) + varTme
            varTme = varTme + (1 / 48)
            i = i + 1
        Loop
        
        varTme = (Int(varPtA) - Int(varStt)) + varPtA - Int(varPtA)
        .Cells(i, 2) = varSttB
        .Cells(i, 3) = Int(varStt) + varTme
        varSttB = Int(varStt) + varTme
        varTme = (Int(varPtA) - Int(varStt)) + (Hour(varStt) / 24) + ((Int(Minute(varPtA) / 30) * (1 / 48)) + (1 / 48))
        i = i + 1
        
        Do While Int(varStt) + varTme < varPtB
            .Cells(i, 2) = varSttB
            .Cells(i, 3) = Int(varStt) + varTme
            varSttB = Int(varStt) + varTme
            varTme = varTme + (1 / 48)
            i = i + 1
        Loop
        
        varTme = (Int(varPtB) - Int(varStt)) + varPtB - Int(varPtB)
        .Cells(i, 2) = varSttB
        .Cells(i, 3) = Int(varStt) + varTme
        varSttB = Int(varStt) + varTme
        varTme = (Int(varPtB) - Int(varStt)) + (Hour(varSttB) / 24) + ((Int(Minute(varPtB) / 30) * (1 / 48)) + (1 / 48))
        i = i + 1
        
        Do While Int(varStt) + varTme < varPtC
            .Cells(i, 2) = varSttB
            .Cells(i, 3) = Int(varStt) + varTme
            varSttB = Int(varStt) + varTme
            varTme = varTme + (1 / 48)
            i = i + 1
        Loop
        
        varTme = (Int(varPtC) - Int(varStt)) + varPtC - Int(varPtC)
        .Cells(i, 2) = varSttB
        .Cells(i, 3) = Int(varStt) + varTme
        varSttB = Int(varStt) + varTme
        varTme = (Int(varPtC) - Int(varStt)) + (Hour(varSttB) / 24) + ((Int(Minute(varPtC) / 30) * (1 / 48)) + (1 / 48))
        i = i + 1
        
        Do While Int(varStt) + varTme < varPtD
            .Cells(i, 2) = varSttB
            .Cells(i, 3) = Int(varStt) + varTme
            varSttB = Int(varStt) + varTme
            varTme = varTme + (1 / 48)
            i = i + 1
        Loop
        
        varTme = (Int(varPtD) - Int(varStt)) + varPtD - Int(varPtD)
        .Cells(i, 2) = varSttB
        .Cells(i, 3) = Int(varStt) + varTme
        varSttB = Int(varStt) + varTme
        varTme = (Int(varPtD) - Int(varStt)) + (Hour(varSttB) / 24) + ((Int(Minute(varPtD) / 30) * (1 / 48)) + (1 / 48))
        i = i + 1
        
        Do While Int(varStt) + varTme < varEnd
            .Cells(i, 2) = varSttB
            .Cells(i, 3) = Int(varStt) + varTme
            varSttB = Int(varStt) + varTme
            varTme = varTme + (1 / 48)
            i = i + 1
        Loop
        
        .Cells(i, 2) = varSttB
        .Cells(i, 3) = varEnd
        .Cells(varRw, 1).Resize(i - varRw + 1) = shtSrc.Cells(n, 1)
        .Cells(varRw, 4).Resize(i - varRw + 1) = shtSrc.Cells(n, 4)
        .Cells(varRw, 5).Resize(i - varRw + 1) = shtSrc.Cells(n, 5)
        i = i + 1
        n = n + 1
                    
    Next
    End With


End Sub

Barely tested, so let me know if you run into issues.

Cheers JB

 

[th081]

i will try this now and get back to you

 

[bellman101]

You might wanna add in the old 'Application.screenupdating = False/True' at the start/end to speed it up a bit.

 

[th081]

Hi JB,

That works perfectly. I am going to spend some time following the logic (trying!). Thank you for taking the time to do this - much appreciated.

Regards

th

 

[bellman101]

You're very welcome.

I always dim any date/times as doubles, as I find it's a lot more stable to work with. If there's anything that doesn't make sense, give me a shout.