splitting entries

[BBQKING3]

I’m looking for help on splitting entries.

I have an excel file with three columns and entries that look like this:

Part number / Date / Qty
XYZ / 2005-11-21 / 5

I need a macro that will look down this list, copy it to
a new sheet, splitting it into multiple entries of the same part number
with single quantities. In other words, 5 individual lines of quantity 1 for the same date.

Part number / Date / Qty
XYZ / 2005-11-21 / 1
XYZ / 2005-11-21 / 1
XYZ / 2005-11-21 / 1
XYZ / 2005-11-21 / 1
XYZ / 2005-11-21 / 1

Anyone have any ideas????

 

[jindon]

Hi

assuming the source data is sheet1
display results in Sheet2

Sub test()
Dim a, i As Long, n As Long
a = Sheets("sheet1").Range("a1").CurrentRegion _
.Resize(, 3).Value
ReDim b(1 To 3, 1 To 1)
For i = 1 To 3
    b(i, 1) = a(1, i)
Next
For i = 2 To UBound(a, 1)
    If IsNumeric(a(i, 3)) And a(i, 3) > 0 Then
        n = UBound(b, 2) + 1
        ReDim Preserve b(1 To 3, 1 To n + a(i, 3) - 1)
        For ii = n To n + a(i, 3) - 1
            For iii = 1 To 3
                b(iii, ii) = a(i, iii)
                If iii = 3 Then b(iii, ii) = 1
            Next
        Next
    End If
Next
With Sheets("sheet2").Range("a1")
    .CurrentRegion.ClearContents
    .Resize(UBound(b, 2), UBound(b, 1)) _
    = Application.Transpose(b)
End With
Erase a, b
End Sub

 

[BBQKING3]

Thanks



It works just fine.
Thanks and have a great day