Excel Macro to Split Multiple Columns into rows

[cali-novice]

I'm looking for a macro to split a table which looks like this:

Row1	aa	tom,dick,harry	clancy,tracy,macy	x1,x2,x3
Row2	bb	mary	berry	z1
Row3	cc	jill,bill	tracy,murray	y1,y2

To one which looks like this:

1	aa	tom	clancy	x1
2	aa	dick	tracy	x2
3	aa	harry	macy	x3
4	bb	mary	berry	z1
5	cc	jill	tracy	y1
6	cc	bill	murray	y2

Thanks!

[LalitPandey87]

Here you go:

*Change data range accordingly

Option Explicit


Sub lmpTest()


    Dim wksSht                      As Worksheet
    Dim varRawData()                As Variant
    Dim lngLoop                     As Long
    Dim lngLoop1                    As Long
    Dim lngCol                      As Long
    Dim lngCount                    As Long
    Dim lngTotalCol                 As Long
    Dim lngTotalSplit               As Long
    Dim varFinalData()              As Variant
    
    Set wksSht = ThisWorkbook.ActiveSheet
    varRawData = wksSht.Range("$A$1:$D$3").Value
    lngCount = 0
    lngCol = 0
    Erase varFinalData
    lngTotalCol = UBound(varRawData, 2)
    For lngLoop = LBound(varRawData) To UBound(varRawData)
        If InStr(varRawData(lngLoop, 2), ",") Then
            If lngCount = 0 Then
                lngTotalSplit = UBound(Split(varRawData(lngLoop, 2), ",")) + 1
                lngCount = lngTotalSplit
                lngCol = 1
            Else
                lngTotalSplit = UBound(Split(varRawData(lngLoop, 2), ",")) + 1
                lngCount = UBound(varFinalData, 2) + lngTotalSplit
                lngCol = UBound(varFinalData, 2) + 1
            End If
            ReDim Preserve varFinalData(1 To lngTotalCol, 1 To lngCount)
            For lngLoop1 = 0 To lngTotalSplit - 1
                varFinalData(1, lngCol + lngLoop1) = varRawData(lngLoop, 1)
                varFinalData(2, lngCol + lngLoop1) = Split(varRawData(lngLoop, 2), ",")(lngLoop1)
                varFinalData(3, lngCol + lngLoop1) = Split(varRawData(lngLoop, 3), ",")(lngLoop1)
                varFinalData(4, lngCol + lngLoop1) = Split(varRawData(lngLoop, 4), ",")(lngLoop1)
            Next lngLoop1
        Else
            If lngCount = 0 Then
                lngCount = 1
            Else
                lngCount = UBound(varFinalData, 2) + 1
            End If
            ReDim Preserve varFinalData(1 To lngTotalCol, 1 To lngCount)
            lngCol = lngCount
            varFinalData(1, lngCol) = varRawData(lngLoop, 1)
            varFinalData(2, lngCol) = varRawData(lngLoop, 2)
            varFinalData(3, lngCol) = varRawData(lngLoop, 3)
            varFinalData(4, lngCol) = varRawData(lngLoop, 4)
        End If
    Next lngLoop
    varFinalData = Application.Transpose(varFinalData)
    With wksSht
        .Range("G1").Resize(, lngTotalCol).EntireColumn.ClearContents
        .Range("G1").Resize(UBound(varFinalData), UBound(varFinalData, 2)).Value2 = varFinalData
    End With
    
    Set wksSht = Nothing
    Erase varRawData
    lngLoop = Empty
    lngLoop1 = Empty
    lngCol = Empty
    lngCount = Empty
    lngTotalCol = Empty
    lngTotalSplit = Empty
    Erase varFinalData


End Sub

[snb]

or

Sub M_snb()
    sn = Cells(1).CurrentRegion
    ReDim sp(UBound(sn) * 3, 3)
    
    y = 0
    For j = 1 To UBound(sn)
      st = Split(sn(j, 2), ",")
      For jj = 0 To UBound(st)
         sp(y, 0) = sn(j, 1)
         sp(y, 1) = st(jj)
         sp(y, 2) = Split(sn(j, 3), ",")(jj)
         sp(y, 3) = Split(sn(j, 4), ",")(jj)
         y = y + 1
      Next
    Next

    Cells(10, 1).Resize(UBound(sp) + 1, 4) = sp
End Sub