Creating unique rows of SKUs on Excel from single rows

Question

I have a lot of rows of data in Excel, each one corresponds to a product. So for example, my first row is "Lady's Black Dress" and then it has in another cell, sizes separated by commas and also colours in one cell too.

Title           Size          Colour                 Price Before  Price After
Ladies Dress    S,M,L,XL,XXL  Blue, Black, Red       19.99          29.99
Men's Trousers  S,M,L,XL,XXL  Brown, Yellow, Orange  39.99          59.99

hj

So what I need is a VBA that creates a unique row (SKU, essentially) for each product variaton, so my data then looks like this:

I did ask this question before but only for 2 columns, a kind soul provided this VBA which does work, but I need the other columns. I don't quite understand how to adapt this VBA and was changing the letter "B" to "E" but this doesn't seem to work.

Option Explicit

Sub sizeExpansion()
    Dim i As Long, szs As Variant

    With Worksheets("sheet1")
        For i = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
            szs = Split(.Cells(i, "B").Value2, ",")
            If CBool(UBound(szs)) Then
                .Cells(i, "A").Resize(UBound(szs), 1).EntireRow.Insert
                .Cells(i, "A").Resize(UBound(szs) + 1, 1) = .Cells(UBound(szs) + i, "A").Value2
                .Cells(i, "B").Resize(UBound(szs) + 1, 1) = Application.Transpose(szs)
            End If
        Next i
    End With

End Sub

Answer 1

Try this modification with an additional split variant and some maths adjustment.

Option Explicit

Sub sizeAndColorExpansion()
    Dim i As Long, s As Long, c As Long
    Dim ttl As String, pb As Double, pa As Double
    Dim szs As Variant, clr As Variant

    With Worksheets("sheet1")
        For i = .Cells(.Rows.Count, "E").End(xlUp).Row To 2 Step -1
            ttl = .Cells(i, "A").Value2
            pb = .Cells(i, "D").Value2
            pa = .Cells(i, "E").Value2
            szs = Split(.Cells(i, "B").Value2, ",")
            clr = Split(.Cells(i, "C").Value2, ",")
            If CBool(UBound(szs)) Or CBool(UBound(clr)) Then
                .Cells(i, "A").Resize((UBound(szs) + 1) * (UBound(clr) + 1) - 1, 1).EntireRow.Insert
                For s = 0 To UBound(szs)
                    For c = 0 To UBound(clr)
                        .Cells(i + (s * (UBound(clr) + 1)) + c, "A").Resize(1, 5) = _
                            Array(ttl, Trim(szs(s)), Trim(clr(c)), pb, pa)
                    Next c
                Next s
            End If
        Next i
    End With

End Sub