VBA - Split time range in 10 seconds increments

[mitko007]

Hi i need some help with the following issue:

In Column A i have a start date & time and in Column B my end date & time. I would like to split these intervals into 10 second increments in Column D (see attached screenshot)



Any suggestions would be appreciated.

Thanks

[mancubus]

hi.

A1 = Start Date
B1 = End Date

[vba]
Sub AddSecs()

Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).Clear
Range("D1") = Range("A1")
i = 2
Do
Range("D" & i) = DateAdd("s", 10, Range("D" & i - 1))
If Range("D" & i) = Range("B1") Then Exit Do
i = i + 1
Loop
Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub
[/vba]

[snb]

In D2: 01-01-2013 00:00:00
In D3: 01-01-2013 00:00:10

Select D2:D3;
drag down using the handle.

[mitko007]

hi.

A1 = Start Date
B1 = End Date

[vba]
Sub AddSecs()

Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).Clear
Range("D1") = Range("A1")
i = 2
Do
Range("D" & i) = DateAdd("s", 10, Range("D" & i - 1))
If Range("D" & i) = Range("B1") Then Exit Do
i = i + 1
Loop
Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub
[/vba]

Hi thanks for the answer but unfortunately it doesn't work. First it loops until the last row in excel is reached and second i doesn't take the exact start and end time as in Column A & B.

[mancubus]

i cant duplicate the problem. i tested the procedure before posting here.

see the attached file.

this line is added to prevent an endless loop:
[vba]
If Range("D" & i) = Range("B1") Then Exit Do
[/vba]

loop does not end means the code cannot test the condition. regional settings maybe. i dont know.

[mitko007]

Thanks mate, you were of great help. I don't now what i messed up the first time but now it work great. However there is still one more issue i need to figure out. As you can see from my first screenshot A3 & B3 define a new Time range which should be filled just as the previous one after the first range (A2-B2) ends. I marked it green. Do you have a solution for that.
I have many Time ranges just as these and i want to have a loop that goes through all of them and splits each in 10s increments just as you did for the first one.

I really appreciate your effort.
Bye

[mancubus]

i cannot see any attachment. probably because of internet filters.

can you attach your file.

click Go Advanced, scroll down, click Manage Attachments... to upload a file...

[mitko007]

i cannot see any attachment. probably because of internet filters.

can you attach your file.

click Go Advanced, scroll down, click Manage Attachments... to upload a file...

i modified Sheet1 in your file. I added a new time range and colored the cells yellow where the splited results should be filled

[mancubus]

[VBA]
Sub AddSecsMulti()
Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).Clear

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
Range("D" & Rows.Count).End(xlUp).Offset(1) = Range("A" & i)
Do
With Range("D" & Rows.Count).End(xlUp)
.Offset(1) = DateAdd("s", 10, .Value)
If .Value = Range("B" & i) Then Exit Do
End With
Loop
Next i

Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub
[/VBA]

[mitko007]

[vba]
Sub AddSecsMulti()
Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).Clear

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
Range("D" & Rows.Count).End(xlUp).Offset(1) = Range("A" & i)
Do
With Range("D" & Rows.Count).End(xlUp)
.Offset(1) = DateAdd("s", 10, .Value)
If .Value = Range("B" & i) Then Exit Do
End With
Loop
Next i

Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub
[/vba]

Works almost perfectly...just that the loop should end i step earlier, since i get one additional 10 secs increment added to each time range (see attached)

[mancubus]

sorry. my bad.

just a quick fix:
change the if statement to
[VBA]
If .Value = Range("B" & i) Then .Offset(1).Clear: Exit Do
[/VBA]

[mitko007]

sorry. my bad.

just a quick fix:
change the if statement to
[vba]
If .Value = Range("B" & i) Then .Offset(1).Clear: Exit Do
[/vba]

Thanks for everything....works great. Have a nice day and sorry for keeping you busy with this

Bye

[mancubus]

you are most welcome.

i glad i could help.

[mitko007]

One more question mancubus,
if i have an additional column containing information about my time ranges,
is there an option to copy it next to my splitted time. I attached your file, and i manually did the copying so that you see what i mean.

Thanks

[mancubus]

[vba]
Sub AddSecsMulti()
Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).Clear

For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
Range("D" & Rows.Count).End(xlUp).Offset(1) = Range("A" & i)
Do
With Range("D" & Rows.Count).End(xlUp)
.Offset(1, 0) = DateAdd("s", 10, .Value)
.Offset(0, 1) = Range("C" & i)
If .Value = Range("B" & i) Then .Offset(1).Clear: Exit Do
End With
Loop
Next i

Range("D1" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub
[/vba]

[mitko007]

i just wanted to tell you that i got this by myself..i figured out the role of .offset )) thanks anyway