Copy rows and move on

[bg]

In Excel2000, I have the following data in columns A and B:

A B
01 info xyz
02 info xyz
03 info xyz

I need a macro that will let me select a range (Column A) and then test each
cell. For example " IF cell = "01" or "03" then insert and copy cell row 3
times and If cell = "02" then insert and copy cell row 4 times so that this
selected are looks like this:

A B
01 info xyz
01 info xyz
01 info xyz
01 info xyz
02 info xyz
02 info xyz
02 info xyz
02 info xyz
02 info xyz
03 info xyz
03 info xyz
03 info xyz
03 info xyz

Thanks

 

[William Benson]

Hi bg,

This may not be the simplest approach, but I think it gets the job done:

Sub AddRows()
Dim i As Long, AdditionalRows As Long, NextRow As Long
Dim Cel As Range

For Each Cel In ActiveSheet.Range("A1").EntireColumn.Cells
If Cel.Value = "" Then
Exit For
Else
If IsNumeric(Cel.Value) Then
AdditionalRows = AdditionalRows + CLng(Cel.Value) + 3
End If
End If
Next Cel

If ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row +
AdditionalRows < 65537 Then
For Each Cel In ActiveSheet.Range("A1").EntireColumn.Cells
If NextRow > 0 Then
NextRow = NextRow - 1
GoTo NextCel
End If

NextRow = 0
If Cel.Value <> "" And IsNumeric(Cel.Value) Then
For i = 1 To CLng(Cel.Value)
Cel.Offset(1, 0).EntireRow.Insert
Cel.EntireRow.Copy Cel.Offset(1, 0)
Next i
NextRow = NextRow + i - 1
End If
NextCel:
Next Cel
Else
MsgBox "You need to add " & AdditionalRows & " rows, which will push
data off the bottom of the page -- aborting"
End If

End Sub

 

[William Benson]

Sorry, misinterpreted the requirements...

This is more exactly what you needed...

Sub AddRows2()
Dim i As Long, AdditionalRows As Long, NextRow As Long
Dim Cel As Range

For Each Cel In ActiveSheet.Range("A1").EntireColumn.Cells
If NextRow > 0 Then
NextRow = NextRow - 1
GoTo NextCel
End If
NextRow = 0
If Cel.Value <> "" And IsNumeric(Cel.Value) Then
For i = 1 To IIf(CLng(Cel.Value) = 2, 4, 3)
Cel.Offset(1, 0).EntireRow.Insert
Cel.EntireRow.Copy Cel.Offset(1, 0)
Next i
NextRow = NextRow + i - 1
End If
NextCel:
Next Cel

End Sub

 

[bg]

Thanks so much for your reply. It works perfectly.

When you get a chance can you please explain the macro. I just want to try
to understand what your logic was. I understand the syntax. I have written
Excel macros before.

Thanks again.

 

[William Benson]

Hi bill,

It was 2AM ... that says a lot.

The For each cel ... loop is based on a moving target. The number of rows is
increasing each time you insert & copy ... but the rows you want to check is
not increasing because none of the inserted rows should be counted. In order
to skip the cells we don't want to test, we need to move forwards in the
collection. Luckily, the cells collection is maintaining all the object in
natural order (by rows) so that iterating always takes us down the sheet,
rather than jumping all around. At least for a single-column such as we are
moving through.

I could not use a For-Next to do the skipping, because by jumping to NextCel
I never hit the incrementer "Next i"
i.e., could not use this: For i = 1 to SkippedRows
Goto NextCel
Next i

So I used:
If SkippedRows > 0 Then
SkippedRows =
SkippedRows - 1
GoTo NextCel
End If


Below is revision with a couple comments added...

Sub AddRows2()
Dim i As Long, SkippedRows As Long, Cel As Range

For Each Cel In ActiveSheet.Range("A1").EntireColumn.Cells

If SkippedRows > 0 Then
SkippedRows = SkippedRows - 1
GoTo NextCel
End If
SkippedRows = 0
If Cel.Value <> "" And IsNumeric(Cel.Value) Then
For i = 1 To IIf(CLng(Cel.Value) = 2, 4, 3)
'Make room for the new row
Cel.Offset(1, 0).EntireRow.Insert
'copy the current row 1 row down
Cel.EntireRow.Copy Cel.Offset(1, 0)
Next i
'after the loop ends, i will be 1 higher than count of inserted rows
SkippedRows = i - 1
End If
NextCel:
Next Cel

End Sub