Copy rows in excel and increment a column

Question

I am trying to create an excel macro that will take a spreadsheet that has n number of rows in it and copy each row as many times as a number located within one of the cells. Also it would increment one of the numbers within a cell. For example I have a layout like the following:

Column1 Column2 Column3 Column4, etc..
Data-a Data-a 1000 5
Data-b Data-b 4600 10

The result would be:
Column1 Column2 Column3 Column4
Data-a Data-a 1000 5
Data-a Data-a 1001 5
Data-a Data-a 1002 5
Data-a Data-a 1003 5
Data-a Data-a 1004 5
Data-b Data-b 4600 10
Data-b Data-b 4601 10
Data-b Data-b 4602 10
Data-b Data-b 4603 10
Data-b Data-b 4604 10
Data-b Data-b 4605 10
Data-b Data-b 4606 10
Data-b Data-b 4607 10
Data-b Data-b 4608 10
Data-b Data-b 4609 10

Hopefully this makes sense. Looking for someone who may be a little more versed with this type of macro to shed some light or point me in the right direction.

Thanks,
Eric

Answer 1

I tested this code and it seemed to work ok. To make this work you need to select 'Data-a' in your inital list of data i.e. top-left hand cell.

There are three procedures:

1. InsertNewRows: This simply inserts the required number of blank new rows
2. ReplicateData: This poulates the blank rows with the correct data
3. TransformData: This is the main procedure that loops through each line that needs replicating

---

Sub InsertNewRows(TargetRow As Integer, TargetCol As Integer, Reps As Integer)
    Dim iRep As Integer
    For iRep = 1 To Reps - 1
        Cells(TargetRow + iRep, TargetCol).EntireRow.Insert Shift:=xlDown
    Next iRep
End Sub

---

Sub ReplicateData(TargetRow As Integer, TargetCol As Integer, Reps As Integer)
Dim iRep As Integer
    For iRep = 1 To Reps - 1
        With Cells(TargetRow, TargetCol)
            .Offset(iRep, 0).Value = .Value
            .Offset(iRep, 1).Value = .Offset(0, 1).Value
            .Offset(iRep, 2).Value = .Offset(0, 2).Value + iRep
            .Offset(iRep, 3).Value = .Offset(0, 3).Value
        End With
    Next iRep
End Sub

---

Sub TransformData()
Dim nRows As Long

nRows = ActiveCell.CurrentRegion.Rows.Count

Dim StartingRow As Integer
Dim StartingColumn As Integer
Dim NumberOfReplications As Integer
Dim RowOffset

StartingRow = ActiveCell.Row
StartingColumn = ActiveCell.Column
NumberOfReplications = 0
RowOffset = 0

Dim iIterations As Integer

For iIterations = 1 To nRows

If Not VBA.IsEmpty(Cells(StartingRow + RowOffset, StartingColumn)) Then
   NumberOfReplications = Cells(StartingRow + RowOffset, StartingColumn).Offset(0, 3)
   InsertNewRows StartingRow + RowOffset, StartingColumn, NumberOfReplications
   ReplicateData StartingRow + RowOffset, StartingColumn, NumberOfReplications
   RowOffset = RowOffset + NumberOfReplications
End If

Next iIterations

End Sub