Jul 21 2022 06:50 AM
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.
Jul 21 2022 07:45 AM
SolutionSub 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.
Jul 21 2022 12:24 PM
Jul 21 2022 07:45 AM
SolutionSub 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.