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 column.

For example, case # 6 has 3 codes. I would like to create a new row for each code and split the dollar amount evenly across all the 3 codes. Thanks in advance for your help

Original

Case  #SpendCodeMaster Project(s)Date
6$900SB25, RT3SD, JI890F1/6/2020

 

After Splitting Codes

Case  #SpendCodeMaster Project(s)Date
6$300SB25F1/6/2020
6$300RT3SDF1/6/2020
6$300JI890F1/6/2020

 

 

Data Set

Case  #SpendCodeMaster Project(s)Date
1($853)T3640A1/1/2020
3$26,185AK30, A484C1/3/2020
4$184,383TBLP, UH07D1/4/2020
5$2,192AK045, D24GE1/5/2020
6$900SB25, RT3SD, JI890F1/6/2020
20$546M643, SS00T1/20/2020
26$114,432UI7, UFR, UE95, UE52Z1/26/2020
27$20,962UG34, UGFRAA1/27/2020
28$64,689UG77AB1/28/2020
29$229,271TBLP, U80, U76AC1/29/2020
32$125,366TLP, UG1, 0FR, U76AF2/1/2020
47$13,538AK36, AK04AU2/16/2020
48$3,279XP17, XR14AV2/17/2020
49$8,970AK84AW2/18/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

3 Replies

  • 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
    • dw700d's avatar
      dw700d
      Copper Contributor

      HansVogelaar 

       

      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

Resources