VBA to split multi-line text in a excel cell into separate rows and keeping adjacent cell values

Question

Please see the attach image which shows my data and expected data after running the macro,

• I would like to split the multi line cell in column B and listed in

Answer 1

I assume the original data is in worksheet "DATA", and worksheet "Expected Output" which is used to store processed data , exist already.

Your code will be:　Operation of most lines are explained by comments (right of "'")

Sub processData()
Dim oWS As Worksheet, pWS As Worksheet
Dim oRow As Long, pRow As Long
Dim splitMultiLine As String, splitPerfix As String
Dim c As Long, i As Long, j As Long, k As Long
Dim prefixes As Variant, lines As Variant
Dim dataACol As String, dataBCol As String, dataCCol As String


Set oWS = Worksheets("DATA") 'original data
Set pWS = Worksheets("Expected Output") 'processed data

'Copy title row
For c = 1 To 3
  pWS.Cells(1, c) = oWS.Cells(1, c)
Next c

oRow = 2 ' row of oWS
pRow = 2 ' row of pWS

With oWS
  While (.Cells(oRow, 1) <> "") 'Loop while A colmn has value
    dataACol = .Cells(oRow, 1) 'data in A column
    dataBCol = .Cells(oRow, 2) 'data in B column
    dataCCol = .Cells(oRow, 3) 'data in C colum

    prefixes = Split(dataACol, ",") ' split prefixes by comma
    lines = Split(dataBCol, Chr(10)) ' split multi lines in a cell by newline (Char(10))

    For i = LBound(prefixes) To UBound(prefixes)
      For j = LBound(lines) To UBound(lines)
        pWS.Cells(pRow, 1) = Trim(prefixes(i)) ' A column of output
        k = InStr(lines(j), " ")
        pWS.Cells(pRow, 2) = Left(lines(j), k - 1) ' B column of output
        pWS.Cells(pRow, 3) = dataCCol ' C column of output
        pRow = pRow + 1
      Next j
    Next i
    oRow = oRow + 1
  Wend
End With
End Sub