Tell me more ×
Stack Overflow is a question and answer site for professional and enthusiast programmers. It's 100% free, no registration required.
up vote 0 down vote favorite

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. I'm 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.

share|improve this question
Do you want to copy to a new worksheet or insert the new rows into the existing worksheet? – barrowc Mar 19 '10 at 23:01

1 Answer

up vote 1 down vote

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 populates 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
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.