splitting entries


Board Regular
Nov 16, 2005
:( 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????


MrExcel MVP
Aug 21, 2004

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)
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
    End If
With Sheets("sheet2").Range("a1")
    .Resize(UBound(b, 2), UBound(b, 1)) _
    = Application.Transpose(b)
End With
Erase a, b
End Sub

Forum statistics

Latest member
Winfield Ullrich I

Some videos you may like

This Week's Hot Topics

  • Problem with Radio Button's format control
    I am creating an employee evaluation template (a sample is below) Column A is the category Column B, C D, E and F will be ratings (unacceptable...
  • Last Display on userform to a Listbox
    [CODE=vba] lstdisplay.ColumnCount = 15 lstdisplay.RowSource = "A1:O600000" [/CODE] So when i do this it Displays everything on the sheet i am...
  • Rename and move files to a new location
    Dear all, I have an excel file with the following information. The actual file name is at column A but i want to rename it using the following...
  • Help with True/False Formula
    Hello! Am stumped how to fix this formula, in which my result returns 'True', but it should return False. =IF(AG2=True...
  • Clear extra characters from a provided range of cells
    Dear All, I have following code which gives me desired output to remove extra characters from a provided range. But it takes too much time when...
  • Help with Current and highest streaks
    Hi there, I've just joined the forum and this is my first post. I've already spent quite a bit of time searching the net and this forum for a...