Parse Text, Split to New Row, Multiple Columns

Hi

See how this goes.

Sub aaa()
  Dim i As Long, j As Integer, resizelen As Integer, curlen As Integer
  resizelen = 1
  Columns("A:A").ColumnWidth = 12
  Columns("B:B").ColumnWidth = 1.5
  Columns("C:C").ColumnWidth = 10
  Columns("D:D").ColumnWidth = 1.5
  Columns("E:E").ColumnWidth = 46.5
  Columns("F:F").ColumnWidth = 1.5
  Columns("G:G").ColumnWidth = 34.5
  Columns("H:H").ColumnWidth = 1.5
  Columns("I:I").ColumnWidth = 15.5
  Columns("J:J").ColumnWidth = 1.5

  
  Application.DisplayAlerts = False
  For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    Cells(i + 1, 1).Resize(resizelen, 1).EntireRow.Insert shift:=xlDown
    For j = 1 To 5
      
      curlen = Round(Len(Cells(i, j)) / Cells(i, j).ColumnWidth, 0)
      If curlen > resizelen Then
        Cells(i, 1).Offset(resizelen + 1, 0).Resize(curlen - resizelen, 1).EntireRow.Insert shift:=xlDown
        resizelen = curlen
      End If
      Cells(i, j).Justify
    Next j
  Next i
  Application.DisplayAlerts = True
  
  For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If IsEmpty(Cells(i, 1)) And Cells(i, 1).End(xlToRight).Column = Columns.Count Then 'ie it is a blank line
      Cells(i, 1).EntireRow.Delete
    End If
  Next i
End Sub

rylo