comma separated array into  rows

Private Sub split_text_Click()
Dim words_found() As String, prematch() As String, aftermatch() As String
Dim R As Long, R1 As Integer
Dim Res As Worksheet, Src As Worksheet
Dim Str As Range
Dim i As Long, j As Integer
With ActiveWorkbook
    Set Src = .Worksheets("Sheet1") 'Correct name if it is different
    'Add new worksheet for results
    Set Res = .Worksheets.Add
End With
'Fill Headeres
With Src
    .Range("A1:E1").Copy Res.Range("A1:E1")
    Res.Range("A:E").Columns.AutoFit
    R = 2
    R1 = 2
   Do While .Cells(R, 1) <> ""
    words_found = Split(.Cells(R, 3), ",")
    prematch = Split(.Cells(R, 4), ",")
    aftermatch = Split(.Cells(R, 5), ",")
    i = WorksheetFunction.Max(UBound(words_found), UBound(prematch), UBound(aftermatch))
    For j = 0 To i
        .Range("A" & R & ":B" & R).Copy Res.Range("A" & R1)
        If UBound(words_found) >= j Then Res.Cells(R1, 3) = words_found(j)
        If UBound(prematch) >= j Then Res.Cells(R1, 4) = prematch(j)
        If UBound(aftermatch) >= j Then Res.Cells(R1, 5) = aftermatch(j)
        R1 = R1 + 1
    Next j
    R = R + 1
   Loop
End With
End Sub

Select all Open in new window

No