Forum Discussion

dw700d's avatar
dw700d
Copper Contributor
Sep 29, 2020
Solved

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...
  • HansVogelaar's avatar
    Sep 29, 2020

    dw700d 

    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

Resources