SOLVED

How to duplicate rows based on cell values on that same row

Copper Contributor

Hi everyone,

 

This is a request that I received from my company, I've worked with excel for years but have never seen something like this.

 

I need to double or triple a row based on values from the same row, for example, if a row only has spend, it stays that way, if it has spend and tax, it has to be doubled, one row for spend and another for tax, if it has spend, tax and "other", it has to be tripled, one row for each item respectively.

 

Please see the example, I did this manually, but I need a way to make it work automatically for hundreds of lines.

 

Thank you.

 

Capture.PNG

 

 

2 Replies
best response confirmed by leocsmith1640 (Copper Contributor)
Solution

@leocsmith1640 

Sub expand()

Dim i As Long
Dim k As Long
Dim maxrow As Long

Range(Cells(2, 11), Cells(2000, 19)).Clear

maxrow = Cells(Rows.Count, 1).End(xlUp).Row
k = 2

For i = 2 To maxrow

If Cells(i, 5).Value > 0 And Cells(i, 6).Value > 0 And Cells(i, 7).Value > 0 Then

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k, 11), Cells(k, 19))
Range(Cells(k, 16), Cells(k, 17)).Clear

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k + 1, 11), Cells(k + 1, 19))
Cells(k + 1, 15).Clear
Cells(k + 1, 17).Clear

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k + 2, 11), Cells(k + 2, 19))
Cells(k + 2, 15).Clear
Cells(k + 2, 16).Clear

k = k + 3
Else

If Cells(i, 5).Value > 0 And Cells(i, 6).Value > 0 Then

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k, 11), Cells(k, 19))
Cells(k, 16).Clear

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k + 1, 11), Cells(k + 1, 19))
Cells(k + 1, 15).Clear

k = k + 2

Else

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k, 11), Cells(k, 19))

k = k + 1

End If

End If

Next i

End Sub

You can try these lines of code. In the attached file you can click the button in cell U4 to run the macro.

Hi @OliverScheurich,

Thank you very much for your answer, this what I was looking for.
1 best response

Accepted Solutions
best response confirmed by leocsmith1640 (Copper Contributor)
Solution

@leocsmith1640 

Sub expand()

Dim i As Long
Dim k As Long
Dim maxrow As Long

Range(Cells(2, 11), Cells(2000, 19)).Clear

maxrow = Cells(Rows.Count, 1).End(xlUp).Row
k = 2

For i = 2 To maxrow

If Cells(i, 5).Value > 0 And Cells(i, 6).Value > 0 And Cells(i, 7).Value > 0 Then

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k, 11), Cells(k, 19))
Range(Cells(k, 16), Cells(k, 17)).Clear

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k + 1, 11), Cells(k + 1, 19))
Cells(k + 1, 15).Clear
Cells(k + 1, 17).Clear

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k + 2, 11), Cells(k + 2, 19))
Cells(k + 2, 15).Clear
Cells(k + 2, 16).Clear

k = k + 3
Else

If Cells(i, 5).Value > 0 And Cells(i, 6).Value > 0 Then

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k, 11), Cells(k, 19))
Cells(k, 16).Clear

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k + 1, 11), Cells(k + 1, 19))
Cells(k + 1, 15).Clear

k = k + 2

Else

Sheets("Tabelle1").Range(Cells(i, 1), Cells(i, 9)).Copy Sheets("Tabelle1").Range(Cells(k, 11), Cells(k, 19))

k = k + 1

End If

End If

Next i

End Sub

You can try these lines of code. In the attached file you can click the button in cell U4 to run the macro.

View solution in original post