Itemize Product based on quantity into Multiple Rows

**sostenes** · 12-05-2012, 05:23 PM

Hi,

I need help with itemizing each product into a separate row based on the quantity:

Example:

This is currently what I have:

[Product][Quantity]
[CRT00000][3]
[CRT00001][2]

This is what I need:

[CRT00000][1]
[CRT00000][1]
[CRT00000][1]
[CRT00001][1]
[CRT00001][1]

Does anyone know how I can make this happen?

Thank you very much in advance.

**rylo** · 12-05-2012, 08:32 PM

Hi

Macro perhaps

Sub aaa()
  Range("D1:E1").Value = Range("A1:B1").Value
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To Cells(i, 2)
      outrow = Cells(Rows.Count, "D").End(xlUp).Offset(1, 0).Row
      Cells(outrow, 4).Value = Cells(i, 1).Value
      Cells(outrow, 5).Value = 1
    Next j
  Next i
End Sub

rylo

**stanleydgromjr** · 12-05-2012, 08:52 PM

sostenes,

I assume that cell A1 contains Product and cell B1 contains Quantity.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Option Explicit
Sub ReorgData()
' stanleydgromjr, 12/05/2012
' http://www.excelforum.com/excel-general/881780-itemize-product-based-on-quantity-into-multiple-rows.html
Dim r As Long, lr As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 2 Step -1
  If Cells(r, 2).Value > 1 Then
    Rows(r + 1).Resize(Cells(r, 2).Value - 1).Insert
    Cells(r + 1, 1).Resize(Cells(r, 2).Value - 1) = Cells(r, 1).Value
    Cells(r, 2).Resize(Cells(r, 2).Value) = 1
  End If
Next r
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.