CRLF - Lines Split by Carriage Return, Line Feed

Location: http://www.mvps.org/dmcritchie/excel/crlf.htm      
Home page: http://www.mvps.org/dmcritchie/excel/excel.htm
[View without Frames]

Determining what character(s) is used

You may have to verify that it is linefeed character separating lines it is possible that you have CHR(13), CHR(10), or CHR(13)&CHR(10) If macro doesn't split properly, use CODE worksheet function to test a single byte -- remove part in front before testing.

Splitting up some lines with LF into separate rows

Don't know what you want to do about Column A when you split up Column B.  Column C is not checked for but just mirrors what is done for Column B.
Option Explicit
Sub Macro21()
'  David McRitchie, misc,  2001-08-06
'  http://wwww.mvps.org/dmcritchie/excel/crlf.htm
'  --look for Chr(10) from bottom
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual

    Dim i As Long, j As Long, k As Long
    For i = Cells(Cells.Rows.Count, "A").End(xlUp).Row _
                      To 2 Step -1
      j = Len(Cells(i, 2)) - Len(Replace(Cells(i, 2), _
                            Chr(10), "")) / Len(Chr(10))
      If j > 0 Then
        Rows(i + 1).Resize(j).Insert
        For k = 0 To j - 1
          '-- column A  maybe should be divided up
          '--     instead of copied ??
          Cells(i + k + 1, 1) = Cells(i, 1)
          '-- column B
          Cells(i + k + 1, 2) = Mid(Cells(i + k, 2), _
             InStr(1, Cells(i + k, 2), _
             Chr(10), vbTextCompare) + 1)
          Cells(i + k, 2) = Left(Cells(i + k, 2), _
             InStr(1, Cells(i + k, 2), _
             Chr(10), vbTextCompare) - 1)
          '-- column C
          Cells(i + k + 1, 3) = Mid(Cells(i + k, 3), _
             InStr(1, Cells(i + k, 3), _
             Chr(10), vbTextCompare) + 1)
          Cells(i + k, 3) = Left(Cells(i + k, 3), _
             InStr(1, Cells(i + k, 3), _
             Chr(10), vbTextCompare) - 1)
        Next k
      End If
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
 ABC
1AmountName Job
2100Smith Manager
360 Jones
Williams
Perry
Builder
Designer
Helper
475Riley Director

 ABC
1AmountName Job
2100Smith Manager
360 JonesBuilder
460 WilliamsDesigner
560 PerryHelper
675Riley Director

Related