Macro for automatic row generation with specific values

BioPA

New Member
Joined
Oct 26, 2013
Messages
30
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:

Time InTime OutProduct ID
00:00:1000:00:13A
00:00:1500:00:19B
00:01:2000:01:21C
.........

<tbody>
</tbody>

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

Time InProduct ID
00:00:10A
00:00:11A
00:00:12A
00:00:13A
00:00:15B
00:00:16B
00:00:17B
00:00:18B
00:00:19B
00:01:20C
00:01:21C

<tbody>
</tbody>


Any tip/help would be greatly appreciated
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
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
ABCDE
1Time InTime OutProductIDTime InProductID
200:00:1000:00:13A0:00:10A
300:00:1500:00:19B0:00:11A
400:01:2000:01:21C0:00:12A
50:00:13A
60:00:15B
70:00:16B
80:00:17B
90:00:18B
100:00:19B
110:01:20C
120:01:21C
Sheet1
<br /><br />

Code:
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top