compose time to quarters

[Adora]

Dears,

i need help in VBA as i have some IDs start & end shift times,
but i need to compose this shift time to intervals, eg: if ID: 4455 have a shift start 9:00:00 Am till 4:45:00 PM,
need these shift to compose to be 9:00:00, 9:15:00, 9:30:00 ,,,, till 16:45:00
or the Prtscr does make sense

i need to create the intervals as filled in column "B" based on 2nd shift time table, every ID have it's created intervals,

Gratefully,

 

[Scott Huish]

You didn't say where your data was exactly, so assuming start time in C1, end time in D1.
Increment starts at B2. Change as necessary:

Sub TEST()
Range("B2") = Range("C1")
With Range("B2:B" & Rows.Count)
    .DataSeries , step:=1 / 96, stop:=Range("D1")
    .NumberFormat = "h:mm AM/PM"
End With
End Sub

 

[Adora]

sorry if the inputs aren't complete,
i need to fill the data at column "A" & "B" from the 2nd table as shown, the snap shot is for clarifying, i didn't have any data in "A" & "B", i need then to be as pictured

Gratefully,

 

[Scott Huish]

I can't see any sample, perhaps you could use this add-in: Download

or give a more detailed explanation of where your data is and where you want the time table built.

 

[Adora]

Hello,

simply i have this table only, what i need is to compose every ID shift time to quarters, and this ID duplicate beside every quarter

ID	Start shift	End shift
3294 <tbody> </tbody>	9:00:00	16:45:00
4554 <tbody> </tbody>	9:00:00	16:45:00
4556	13:00:00	20:45:00
1783	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
4550 <tbody> </tbody>	9:00:00 <tbody> </tbody>	16:45:00 <tbody> </tbody>
4553 <tbody> </tbody>	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
2295 <tbody> </tbody>	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
4547 <tbody> </tbody>	9:00:00 <tbody> </tbody>	16:45:00 <tbody> </tbody>
4555 <tbody> </tbody>	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
4551 <tbody> </tbody>	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
3291 <tbody> </tbody>	9:00:00 <tbody> </tbody>	16:45:00 <tbody> </tbody>
3122 <tbody> </tbody>	9:00:00 <tbody> </tbody>	16:45:00 <tbody> </tbody>
4548 <tbody> </tbody>	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
3514 <tbody> </tbody>	13:00:00 <tbody> </tbody>	20:45:00 <tbody> </tbody>
4787 <tbody> </tbody>	9:00:00 <tbody> </tbody>	16:45:00 <tbody> </tbody>
1782	9:00:00	16:45:00 <tbody> </tbody>

<tbody>
</tbody>

as shown at the below picture, the table that located at left in column "A" & "B" didn't found this is for explanation, this table that i want to create via VBA.

the uploaded workbook,
http://1drv.ms/1DQjVVg

 

[Scott Huish]

OK, how about this?

Sub test()
Dim c As Range
For Each c In Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row)
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize((c.Offset(, 2) - c.Offset(, 1)) / TimeSerial(0, 15, 0) + 1) = c
    With Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1)
        .Value = c.Offset(, 1)
        .DataSeries , rowcol:=xlColumns, step:=1 / 96, stop:=c.Offset(, 2)
    End With
Next
Range("B:B").NumberFormat = "HH:MM"
End Sub

 

[Adora]

Hello Scott,

this is really what i looking for, thanks a lot for your co-operation

Gratefully,

 

[Adora]

Hello Scott,

i have a trouble now with the table that have the IDs shift time, this data is extracted via VBA code based on cell color

[COLOR=#333333][FONT=Segoe UI]Function strt(rng As Range) As String[/FONT][/COLOR][COLOR=#333333][FONT=Segoe UI]Dim c As Range
For Each c In rng
    If c.Interior.Color <> 16777215 Then
    strt = c.Column
    Exit Function
    End If
Next[/FONT][/COLOR]
[COLOR=#333333][FONT=Segoe UI]End Function[/FONT][/COLOR]
[COLOR=#333333][FONT=Segoe UI]Function nd(rng As Range) As String
Dim c As Range
Dim found As Boolean
For Each c In rng
If c.Interior.Color <> 16777215 Then found = True
    If found = True Then
    If c.Interior.Color = 16777215 Then
    nd = c.Column
    Exit Function
    End If
    End If
Next[/FONT][/COLOR]
[COLOR=#333333][FONT=Segoe UI]End Function[/FONT][/COLOR]

then when running your code have an error "Type mismatch" due to the source are hidden, it didn't appear unless double click in any cell, in addition to the ID column that your code is create filled with floating point, must use "text to column" option to remove floating, i need to remove floating to some calculation based on this ID columns,

i uploaded the entire workbook "your code" located at "Adherence" worksheet

http://1drv.ms/1zXSN2Q

Gratefully,

 

[Scott Huish]

What are you talking about? Time in Excel is stored as a fraction of a day. My code has a number format to show it as Time.