Is it possible?

[Underdog85]

Hi,

Not an advanced user of excel before so hoping someone can help out with this.

I have a file with approx 1500 rows and approx 10 columns

I need to automate to do the following:

Select a row (row 1) duplicate it underneath as a new row (row 2)
move to the next unique row (row 3) and duplicate (row 4)
move to the next unique row (row 5) and duplicate (row 6)
REPEAT

 

[Special-K99]

Using VBA yes though I'm not an expert at that so it would be over to someone else.

 

[FormR]

Hi, welcome to the board! Here is some VBA code that you can try on a copy of your workbook.

Sub DuplicateRows()


Dim lc As Long, lr As Long


Application.ScreenUpdating = False


lc = Cells(1, Columns.Count).End(xlToLeft).Column
lr = Cells(Rows.Count, "A").End(xlUp).Row


With Cells(1, lc + 1).Resize(lr)
    .Formula = "=row()"
    .Value = .Value
    With .Resize(lr).Offset(, -lc).Resize(, lc + 1)
        .Copy Destination:=.Offset(lr)
        .Resize(lr * 2).Sort key1:=.Cells(1, lc + 1), order1:=xlAscending, Header:=xlNo
    End With
    .EntireColumn.Delete
End With


End Sub

 

[Yongle]

Code from @FormR (which adds a sequence flag , duplicates the data , sorts and deletes the flag ) will run faster

This does things one row at a time, starting from the bottom
- assmes that there is a value in column A in the last row

Sub DupRows()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim r As Long
    With ActiveSheet
        For r = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
            .Rows(r).Copy
            .Cells(r + 1, 1).Insert Shift:=xlDown
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Underdog85]

Thanks for the welcome and the code.

Initial tests on a small batch were successful so thanks!

Seen as that was pretty simple I have another question.

On the duplicated rows only could the code change the data inside the cells on a specific column? So for example change all the data in each cell in the column named 'Variant Price' to 0.00?

 

[FormR]

So for example change all the data in each cell in the column named 'Variant Price' to 0.00?

Hi, do we know in advance which column this is, as in its always column C for example, or do we need to dynamically find it?

 

[Yongle]

This puts 0 in column E
- amend to the correct column

Sub DupRows()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim r As Long
    With ActiveSheet
        For r = .Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
            .Rows(r).Copy
            .Cells(r + 1, 1).Insert Shift:=xlDown
            .Cells(r + 1, [COLOR=#ff0000]5[/COLOR]).Value = 0
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
End Sub

If Variant Price column is one of headers in row 1 and could be any one of the columns , VBA can find it like this ...

Sub DupRows()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim r As Long, [COLOR=#ff0000]vp[/COLOR] As Long
    With ActiveSheet
        [COLOR=#ff0000]vp[/COLOR] = .Rows(1).Find("Variant Price").Column
        For r = .Range("A" & Rows.Count).End(xlUp).Row To [COLOR=#ff0000]2[/COLOR] Step -1
            .Rows(r).Copy
            .Cells(r + 1, 1).Insert Shift:=xlDown
            .Cells(r + 1, [COLOR=#ff0000]vp[/COLOR]).Value = 0
        Next
    End With
    Application.Calculation = xlCalculationAutomatic
End Sub