vba to make Alt+Enter into new row

[bobaol]

Hello, I'm trying to separate cells with a lot of Alt+Enter data into new rows. For example, I have the following in cell A11

09 = ICD-9-CM 10 = ICD-10-CM 11 = ICD-11-CM C4 = CPT-4 H4 = HCPCS-4 RV = Revenue code LO = Local homegrown OT = Other

I would like to have 8 new rows altogether. So then, row 11 would remain the same. then would insert a new row below A11, and in A12, it would be 09 = ICD-9-CM. B12 to XFC12 would be empty as this is an inserted row. then cell A13 would be 10 = ICD-10-CM, and so forth. I have some cells in column a with a lot of Alt+Enter data, and some that have none. For each cell in column A, I want to insert a new row for each Alt+Enter item. any help is appreciated. Thanks in advance.

 

[Alex Blakenburg]

We don't have visibility of your data so I don't know if the Insert is important to you ie
• Is there related data to the right of column A that needs to stay on the same row.
• If Yes, do they contain formula or special formatting.

If it is a simple as just dealing with Column A then this might work for you.
It is using the Active sheet and will output the split data to the same sheet to B11, so make sure you do it on a copy of your workbook.
I believe you wanted to keep the unsplit cell as well.

Sub SplitCells()
    Dim ws As Worksheet
    Dim rngSrc As Range, rngDest As Range
    Dim lastRow As Long, iCntLf As Long
    Dim vSplit As Variant, arrSrc As Variant, arrDest As Variant
    Dim i As Long, j As Long, iOut As Long
    
    Set ws = ActiveSheet
    With ws
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        Set rngSrc = .Range("A11:A" & lastRow)
        arrSrc = rngSrc.Value
        
        Set rngDest = .Range("B11")
    End With
    
    ' Size arrDest
    For i = 1 To UBound(arrSrc)
        vSplit = Split(arrSrc(i, 1), vbLf)
        iCntLf = iCntLf + UBound(vSplit) + 1
    Next i
    
    ReDim arrDest(1 To iCntLf + UBound(arrSrc), 1 To 1)

    ' Split lines
    For i = 1 To UBound(arrSrc)
        ' Retain original data
        iOut = iOut + 1
        arrDest(iOut, 1) = arrSrc(i, 1)
        ' Split Data
        vSplit = Split(arrSrc(i, 1), vbLf)
        For j = LBound(vSplit) To UBound(vSplit)
            iOut = iOut + 1
            arrDest(iOut, 1) = vSplit(j)
        Next j
    Next i
    
    rngDest.Resize(iOut) = arrDest

End Sub

 

[Fuji]

See if this works as you expect...

Sub test()
    Dim i&, x
    For i = Range("a" & Rows.Count).End(xlUp).Row To 1 Step -1
        x = Split(Cells(i, 1).Value, vbLf)
        If UBound(x) > 0 Then
            Rows(i + 1).Resize(UBound(x) + 1).Insert
            Cells(i + 1, 1).Resize(UBound(x) + 1).Value = Application.Transpose(x)
        End If
    Next
End Sub

 

[Cubist]

You can try this for the formula option.

Book1
	A	B
11	09 = ICD-9-CM 10 = ICD-10-CM 11 = ICD-11-CM C4 = CPT-4 H4 = HCPCS-4 RV = Revenue code LO = Local homegrown OT = Other	09 = ICD-9-CM 10 = ICD-10-CM 11 = ICD-11-CM C4 = CPT-4 H4 = HCPCS-4 RV = Revenue code LO = Local homegrown OT = Other
12	16 = ICD-9-CM 17 = ICD-10-CM 18 = ICD-11-CM 19 = CPT-4 H20 = HCPCS-4 RV = Revenue code LO = Local homegrown OT = Other	09 = ICD-9-CM
13	This is something I made up completely to test blah1 blah2 blah3 blah4	10 = ICD-10-CM
14		11 = ICD-11-CM
15		C4 = CPT-4
16		H4 = HCPCS-4
17		RV = Revenue code
18		LO = Local homegrown
19		OT = Other
20		16 = ICD-9-CM 17 = ICD-10-CM 18 = ICD-11-CM 19 = CPT-4 H20 = HCPCS-4 RV = Revenue code LO = Local homegrown OT = Other
21		16 = ICD-9-CM
22		17 = ICD-10-CM
23		18 = ICD-11-CM
24		19 = CPT-4
25		H20 = HCPCS-4
26		RV = Revenue code
27		LO = Local homegrown
28		OT = Other
29		This is something I made up completely to test blah1 blah2 blah3 blah4
30		This is something
31		I made up
32		completely
33		to test
34		blah1
35		blah2
36		blah3
37		blah4
Sheet8

Cell Formulas
Range	Formula
B11:B37	B11	=DROP(REDUCE("",A11:A13,LAMBDA(a,b,VSTACK(a,b,TEXTSPLIT(b,,CHAR(10))))),1)
Dynamic array formulas.

 

[bobaol]

thanks Alex and Fuji, both solutions works for me. But Mr. Excel allows only one Yes box. and thanks Cubist, glad to get a refresher on the modern version of CSE. it's been a while since i last used CSE. I will have to get a refresher on the new #SPILL thingy and so forth.

 

[Cubist]

it's been a while since i last used CSE. I will have to get a refresher on the new #SPILL thingy and so forth.

#SPILL error indicates you didn't provide sufficient cells for the formula to output the result. You'd need to clear out the stuff below. Unlike VBA, spill-formulas do not overwrite the value of existing cells.

 

[Alex Blakenburg]

Thanks for providing us all with feedback. Glad we could help.