Forum Discussion
dw700d
Sep 29, 2020Copper Contributor
Split column add row
Good day, I have a spreadsheet with 26,000 rows. When there are multiple codes in the code column I would like to create a new row and split the spend amounts evenly between each code in the col...
- Sep 29, 2020
Run the following macro:
Sub SplitData() Dim r As Long Dim m As Long Dim a() As String Dim i As Long Dim n As Long Dim d As Double Application.ScreenUpdating = False m = Range("C" & Rows.Count).End(xlUp).Row For r = m To 3 Step -1 a = Split(Range("C" & r).Value, ", ") n = UBound(a) If n > 0 Then d = Range("B" & r).Value / (n + 1) For i = n To 1 Step -1 Range("A" & r).EntireRow.Copy Range("A" & r + 1).EntireRow.Insert Range("B" & r + 1).Value = d Range("C" & r + 1).Value = a(i) Next i Range("B" & r).Value = d Range("C" & r).Value = a(0) End If Next r Application.ScreenUpdating = True End Sub
HansVogelaar
Sep 29, 2020MVP
Run the following macro:
Sub SplitData()
Dim r As Long
Dim m As Long
Dim a() As String
Dim i As Long
Dim n As Long
Dim d As Double
Application.ScreenUpdating = False
m = Range("C" & Rows.Count).End(xlUp).Row
For r = m To 3 Step -1
a = Split(Range("C" & r).Value, ", ")
n = UBound(a)
If n > 0 Then
d = Range("B" & r).Value / (n + 1)
For i = n To 1 Step -1
Range("A" & r).EntireRow.Copy
Range("A" & r + 1).EntireRow.Insert
Range("B" & r + 1).Value = d
Range("C" & r + 1).Value = a(i)
Next i
Range("B" & r).Value = d
Range("C" & r).Value = a(0)
End If
Next r
Application.ScreenUpdating = True
End Sub- dw700dSep 29, 2020Copper Contributor
Thank you for your help that worked perfectly. I have never used a macro before and so i am a complete novice.
I have 19 other columns that are included in the spreadsheet. How do I include the other columns? similar to what you have done for column A,D & E
- HansVogelaarSep 29, 2020MVP
The macro that I posted copies and pastes entire rows, i.e. all columns.