Macro for automatic row generation with specific values

[BioPA]

Hi there,

It's a long time since I wrote my last message. I would be grateful if somebody could help me on this issue:

I have this table with these values:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Time In[/TD]
[TD]Time Out[/TD]
[TD]Product ID[/TD]
[/TR]
[TR]
[TD]00:00:10[/TD]
[TD]00:00:13[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]00:00:15[/TD]
[TD]00:00:19[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]00:01:20[/TD]
[TD]00:01:21[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]...[/TD]
[TD]...[/TD]
[TD]...[/TD]
[/TR]
</tbody>[/TABLE]

and I want to generate multiple rows based on the duration of time In and Out like below:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Time In[/TD]
[TD]Product ID[/TD]
[/TR]
[TR]
[TD]00:00:10[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]00:00:11[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]00:00:12[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]00:00:13[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]00:00:15[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]00:00:16[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]00:00:17[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]00:00:18[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]00:00:19[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]00:01:20[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]00:01:21[/TD]
[TD]C[/TD]
[/TR]
</tbody>[/TABLE]


Any tip/help would be greatly appreciated

 

[shknbk2]

I'm not sure where your input and output columns are, so I used A1-C1 and D1-E1. Change accordingly.

I also assume that the values are text values (maybe imported from a CSV file?)

Book1
	A	B	C	D	E
1	Time In	Time Out	ProductID	Time In	ProductID
2	00:00:10	00:00:13	A	0:00:10	A
3	00:00:15	00:00:19	B	0:00:11	A
4	00:01:20	00:01:21	C	0:00:12	A
5				0:00:13	A
6				0:00:15	B
7				0:00:16	B
8				0:00:17	B
9				0:00:18	B
10				0:00:19	B
11				0:01:20	C
12				0:01:21	C
Sheet1

<br /><br />

Sub expandTimes()
    Dim c As Range, productID As String
    Dim outputRange As Range, outputTimeCol As Integer, inputTimeCol As Integer
    Dim timeIn As Double, timeOut As Double, tempTime As Double, i As Integer
    Dim t As Variant, oneSec As Double
    
    inputTimeCol = 1   'TimeIn column for input
    outputTimeCol = 4  'TimeIn column for output
    
    'clear output columns
    If Cells(2, outputTimeCol).Value <> "" Then
        Range(Cells(1, outputTimeCol), Cells(Rows.Count, outputTimeCol).End(xlUp)).Resize(, 2).Offset(1, 0).ClearContents
    End If
    
    oneSec = TimeSerial(0, 0, 1)
    For Each c In Range(Cells(2, inputTimeCol), Cells(Rows.Count, 1).End(xlUp))
        t = Split(c.Value, ":")
        timeIn = TimeSerial(t(0), t(1), t(2))
        t = Split(c.Offset(0, 1).Value, ":")
        timeOut = TimeSerial(t(0), t(1), t(2))
        productID = c.Offset(0, 2).Value
        For i = 0 To (timeOut - timeIn) / oneSec
            tempTime = timeIn + TimeSerial(0, 0, i)
            Set outputRange = Cells(Rows.Count, outputTimeCol).End(xlUp).Offset(1, 0)
            outputRange.Value = Format(Hour(tempTime), "00") & ":" & Format(Minute(tempTime), "00") & _
                ":" & Format(Second(tempTime), "00")
            outputRange.Offset(0, 1).Value = productID
        Next i
    Next c
End Sub