Excel Macro to Split Multiple Columns into rows

[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