Insert copied row based on value

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

eazyc10@gmail.com - 11 Jun 2007 21:33 GMT

I need some help with an Excel Macro.

I have data set that looks as follows:

| ITEM | DATE | QTY |

1234 6/11 10
1235 6/12 5

ETC.

What I want to be able to do is insert X number of rows based on the
quantity field but have the item and date copy to the new rows.

So for example I would have 10 rows of item 1234 6/11 10 and 5 rows
of 1235 6/12 5

I have the code that inserts the blank rows but do not know how to
copy the existing cells to the new rows:

Dim lastRow As Long, cell As Range

Dim i As Long
lastRow = Cells(Rows.Count, "H").End(xlUp).Row + 1
For i = lastRow To 2 Step -1
Set cell = Cells(i, "H")
If IsNumeric(cell(0, 1).Value) Then
If cell(0, 1).Value >= 1 Then
cell.Resize(cell(0, 1).Value) _
.EntireRow.Insert
End If
End If
Next i

Reply to this Message

krcowen@aol.com - 11 Jun 2007 22:54 GMT

Eazy

This works for me:

Sub test()

Dim j As Long

j = 2

Do While Cells(j, 8) <> ""

If Application.And(IsNumeric(Cells(j, 8)), Cells(j, 8) > 1) Then

Cells(j + 1, 1).Select
Selection.Resize(Cells(j, 8).Value - 1).EntireRow.Insert
Cells(j, 1).Select
Selection.Resize(Cells(j, 8).Value, 8).Select
Selection.FillDown
j = j + Cells(j, 8).Value

Else

j = j + 1

End If

Loop

End Sub

I assumed you want to end up with the number of rows or each line that
you see in column 8 of the line, not insert that many lines. So, if
there is a 5 you need to insert 4 rows, if there is a one, you just
leave it alone. You may need to adjust the counter (j) if that is an
incorrect assumption. If you are deleting rows, it is usually
necessary to start from the bottom, as you did. In a case like this,
where we are inserting rows, I find it is usually easier to keep track
of where you are if you start at the top. I also assumed that the
process would continue until there was a blank in column 8 of the
data. If that is not the case, then you need to change the Do while
logic.

Good luck.

Ken
Norfolk, Va

On Jun 11, 4:33 pm, eazy...@gmail.com wrote:

> I need some help with an Excel Macro.
>
[quoted text clipped - 28 lines]
> End If
> Next i

Reply to this Message

eazyc10@gmail.com - 11 Jun 2007 23:11 GMT

Wow this is exactly what i needed.

Thanks so much Ken!

Eric

Reply to this Message