Forum Discussion

akennedy2225's avatar
akennedy2225
Copper Contributor
Nov 07, 2022

Split cell into multiple rows?

I have a "messy" spreadsheet I'm trying to reconfigure for analysis. There are 450 rows, but here's a sample of two:

IDNameNotes
1Test ASalaries/Benefits: $10,001.01
Purchased Services: $22.99
Supplies/Materials: $500.23
Capital Objects: $7,216.25
2Test BSalaries/Benefits: $3,518.62
Purchased Services: $618.72

With those amounts in the same cell it isn't helpful for doing large reports quickly. Ideally, I'd break it down to match this:

IDNameType Amount 
1Test ASalaries/Benefits:    10,001.01
1Test APurchased Services:            22.99
1Test ASupplies/Materials:          500.23
1Test ACapital Objects:      7,216.25
2Test BSalaries/Benefits:      3,518.62
2Test BPurchased Services:          618.72

I'm assuming this is going to be a multi-step process. I started off trying to use the text-to-columns function on that notes column in the first table, but it only recognized the first amount and deleted everything after that. Currently I'm trying to find some combination of the find and substitute functions that will work.

 

Has anyone else been able to solve a similar problem, or at least an idea of how to solve this? If I were to do this by hand it would take weeks, as I have more spreadsheets like this coming

excel
Formulas and Functions

1 Reply

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Nov 07, 2022

    akennedy2225 

    You could run this macro:

    Sub SplitCells()
    Dim r As Long
    Dim m As Long
    Dim c() As String
    Dim p() As String
    Dim i As Long
    Application.ScreenUpdating = False
    m = Range("A" & Rows.Count).End(xlUp).Row
    For r = m To 2 Step -1
        c = Split(Range("C" & r).Value, vbLf)
        If UBound(c) > 0 Then
            For i = UBound(c) To 1 Step -1
                Range("A" & r + 1).EntireRow.Insert
                Range("A" & r + 1).Value = Range("A" & r).Value
                Range("B" & r + 1).Value = Range("B" & r).Value
                p = Split(c(i), ": $")
                Range("C" & r + 1).Value = p(0)
                Range("D" & r + 1).Value = p(1)
            Next i
            p = Split(c(0), ": $")
            Range("C" & r).Value = p(0)
            Range("D" & r).Value = p(1)
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

Resources