Taking Qty and sorting out to single lines

[Davealot]

Greetings Ladies/Gents,
Once again would ask for some help if possible. There could possibly be a formula for this, I'm not sure of what it would be however. I receive part numbers with random quantities and dates, Such as 4 of **** on date ***** to ship, I'm wanting to somehow have excel take the list of orders due, and parse them out to single quantities, such as taking the order of 4 for part number **** and making 4 separate lines of Part number **** with a quantity of 1. I've attached spreadsheet, thank you kindly for any and all consideration.

 

[chirayu]

Clear out column F to H where you've manually filled in the bits before running this macro

Sub Duplicator()

Dim CurrCell As String 'The cell from which it is splitting out lines
Dim PartNum As String 'Part Number of that cell
Dim DT As Date 'Due Date for that Part Number
Dim i As Integer  'The number of times it needs to replicate the lines

Range("A2").Select
Do Until IsEmpty(ActiveCell)
   
    CurrCell = ActiveCell.Address
    PartNum = ActiveCell
    i = ActiveCell.Offset(0, 1)
    DT = ActiveCell.Offset(0, 2)
   
    For i = 1 To i
       
        Range("F" & Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).Row).Select 'Select 1st blank cell in column F
        ActiveCell = PartNum
        ActiveCell.Offset(0, 1) = 1
        ActiveCell.Offset(0, 2) = DT
        ActiveCell.Offset(1, 0).Select
       
    Next
   
    Range(CurrCell).Select
    ActiveCell.Offset(1, 0).Select

Loop

MsgBox "Done", vbInformation, ""

End Sub

 

[Davealot]

Clear out column F to H where you've manually filled in the bits before running this macro

Sub Duplicator()

Dim CurrCell As String 'The cell from which it is splitting out lines
Dim PartNum As String 'Part Number of that cell
Dim DT As Date 'Due Date for that Part Number
Dim i As Integer  'The number of times it needs to replicate the lines

Range("A2").Select
Do Until IsEmpty(ActiveCell)
  
    CurrCell = ActiveCell.Address
    PartNum = ActiveCell
    i = ActiveCell.Offset(0, 1)
    DT = ActiveCell.Offset(0, 2)
  
    For i = 1 To i
      
        Range("F" & Cells(Rows.Count, "F").End(xlUp).Offset(1, 0).Row).Select 'Select 1st blank cell in column F
        ActiveCell = PartNum
        ActiveCell.Offset(0, 1) = 1
        ActiveCell.Offset(0, 2) = DT
        ActiveCell.Offset(1, 0).Select
      
    Next
  
    Range(CurrCell).Select
    ActiveCell.Offset(1, 0).Select

Loop

MsgBox "Done", vbInformation, ""

End Sub

Excellent, Thanks a bunch I appreciate it greatly!

 

[Marc L]

Hi !

A way directly replacing source range :​

Sub Demo()
    With Sheet1.Cells(1).CurrentRegion
            ReDim VR(1 To Application.Sum(.Columns(2)), 1 To 3)
            VA = .Value
        For R& = 2 To .Rows.Count
            For N% = 1 To VA(R, 2)
                      L& = L& + 1
                VR(L, 1) = VA(R, 1)
                VR(L, 2) = 1
                VR(L, 3) = VA(R, 3)
            Next
        Next
        With .Range("A2:C2").Resize(UBound(VR))
             .Columns(3).NumberFormat = .Cells(3).NumberFormat
             .Value = VR
        End With
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​