Here you go:
*Change data range accordingly
Code:
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
Bookmarks