PDA

View Full Version : VBA - Split time range in 10 seconds increments



mitko007
06-11-2013, 02:34 PM
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)

http://i459.photobucket.com/albums/qq314/mitko0007/split.png

Any suggestions would be appreciated.

Thanks

mancubus
06-11-2013, 11:23 PM
hi.

A1 = Start Date
B1 = End Date


Sub AddSecs()

Range("D1:D" & 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:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub

snb
06-12-2013, 01:55 AM
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
06-12-2013, 03:44 AM
hi.

A1 = Start Date
B1 = End Date


Sub AddSecs()

Range("D1:D" & 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:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub


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.

http://i459.photobucket.com/albums/qq314/mitko0007/result.png

mancubus
06-12-2013, 04:40 AM
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:

If Range("D" & i) = Range("B1") Then Exit Do


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

mitko007
06-12-2013, 04:52 AM
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
06-12-2013, 04:56 AM
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
06-12-2013, 05:08 AM
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
06-12-2013, 05:47 AM
Sub AddSecsMulti()
Range("D1:D" & 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:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub

mitko007
06-12-2013, 06:04 AM
Sub AddSecsMulti()
Range("D1:D" & 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:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub


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
06-12-2013, 06:08 AM
sorry. my bad.

just a quick fix:
change the if statement to

If .Value = Range("B" & i) Then .Offset(1).Clear: Exit Do

mitko007
06-12-2013, 06:14 AM
sorry. my bad.

just a quick fix:
change the if statement to

If .Value = Range("B" & i) Then .Offset(1).Clear: Exit Do


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

Bye

mancubus
06-12-2013, 06:22 AM
you are most welcome.

i glad i could help.

mitko007
06-12-2013, 08:04 AM
One more question mancubus (http://www.vbaexpress.com/forum/member.php?u=37987),
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
06-12-2013, 08:14 AM
Sub AddSecsMulti()
Range("D1:D" & 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:D" & Range("D" & Rows.Count).End(xlUp).Row).NumberFormat = "dd.mm.yyyy hh:mm:ss"
End Sub

mitko007
06-12-2013, 08:16 AM
i just wanted to tell you that i got this by myself..i figured out the role of .offset :))) thanks anyway