I have a spreadsheet with data like this:Spreadsheet Overview Image
In Column "A" I have multiple cells that are multiple paragraphs. Ideally my goal is to break each cell into multiple cells below (or rows below) - separated by paragraphs. My struggle is that there is already data below each existing Column "A" data set. So we would need to insert a custom number of rows determined by existing paragraphs and then transpose down. Ideally I would set this up VBA; but a formula is fine as well.
End Goal: End Goal
If anyone can help out with a solution that would be greatly appreciated.
What I have tried:
I have existing VBA for text to columns but I am seeking higher knowledge.
Sub Delimit()
'splits Text active cell using ALT+10 char
Dim splitVals As Variant
Dim totalVals As Long
Dim i As Integer
For i = 1 To 1000
splitVals = Split(ActiveCell.Value, Chr(10))
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
ActiveCell.Offset(1, 0).Activate
Next i
End Sub
Unsure how to apply this to range of all cells in Column "A" with text and subsequently add in required rows below original rows to accomplish
You could try this:
Sub test()
Dim inputrange As Range, textarray
Set inputrange = ActiveSheet.Range("A1:A1000") 'alter this to suit
textarray = Split(Application.WorksheetFunction. _
TextJoin(Chr(10), True, inputrange), Chr(10))
inputrange.End(xlDown).Resize _
(1 + UBound(textarray) - inputrange.Rows.Count).EntireRow.Insert (xlDown)
inputrange.Cells(1).Resize(1 + UBound(textarray), 1).Value = _
WorksheetFunction.Transpose(textarray)
End Sub
And here is a second version to work around the 32k length limitation of TextJoin
:
Sub test_v2()
Dim inputrange As Range, c As Range, textarray, StrText As String
Set inputrange = ActiveSheet.Range("A1:A1000")
For Each c In inputrange
StrText = StrText & c.Value & Chr(10)
Next
textarray = Split(StrText, Chr(10))
inputrange.End(xlDown).Resize _
(1 + UBound(textarray) - inputrange.Rows.Count).EntireRow.Insert (xlDown)
inputrange.Cells(1).Resize(1 + UBound(textarray), 1).Value = _
WorksheetFunction.Transpose(textarray)
End Sub