Comma separated cells to rows, but preserve data in surrounding columns

Excel Macro - Comma Separated Cells to Rows Preserve/Aggregate Column

My problem is almost exactly the same as the above link except I have data surrounding the columns I want to break out like the following:

 <- A (Category) ->   <- B (Items) -> <- B (Items) -> <- B (Items) -> <- B (Items) ->
  1   Cat1                 date1          a,b,c            a1,b1,c1        item1
  2   Cat2                 date2           d                  d1           item2
  3   Cat3                 date3           e,f                e1,f1        item3
  4   Cat4                 date4           g                  g1           item4

What I want is this:

 <- A (Category) ->   <- B (Items) -> <- C (Items) -> <- D (Items) -> <- E (Items) ->
  1   Cat1                 date1           a    开发者_运维问答              a1           item1
  1   Cat1                 date1           b                  b1           item1
  1   Cat1                 date1           c                  c1           item1
  2   Cat2                 date2           d                  d1           item2
  3   Cat3                 date3           e                  e1           item3
  3   Cat3                 date3           f                  f1           item3 
  4   Cat4                 date4           g                  g1           item4

I want to break out Columns C and D into new rows and copy the items in A, B, and E. There's actually more columns, but I did this to make it easier.

The code below works perfect for only 2 adjacent columns. I was wondering could a range of columns be input to be copied?

Sub ExpandData()
    Const FirstRow = 2
    Dim LastRow As Long
    LastRow = Range("A" & CStr(Rows.Count)).End(xlUp).Row

    ' Get the values from the worksheet
    Dim SourceRange As Range
    Set SourceRange = Range("A" & CStr(FirstRow) & ":B" & CStr(LastRow))

    ' Get sourcerange values into an array
    Dim Vals() As Variant
    Vals = SourceRange.Value

    ' Loop through the rows in the array and split each comma-delimited list of items and put each on its own row
    Dim ArrIdx As Long
    Dim RowCount As Long
    For ArrIdx = LBound(Vals, 1) To UBound(Vals, 1)

        Dim CurrCat As String
        CurrCat = Vals(ArrIdx, 1)

        Dim CurrList As String
        CurrList = Replace(Vals(ArrIdx, 2), " ", "")

        Dim ListItems() As String
        ListItems = Split(CurrList, ",")

        Dim ListIdx As Integer
        For ListIdx = LBound(ListItems) To UBound(ListItems)

            Range("A" & CStr(FirstRow + RowCount)).Value = CurrCat
            Range("B" & CStr(FirstRow + RowCount)).Value = ListItems(ListIdx)
            RowCount = RowCount + 1

        Next ListIdx

    Next ArrIdx

End Sub

One immediate simplification is to

 Set SourceRange = [A1].CurrentRegion

For the rest, it looks like you're on the right track, but you want to change the ListItems... logic to set a Boolean to tell you to split up the other columns.

You end up with an If Then Else with one side handling simple rows and the other side handling the multi-item rows. More code, but simple and unlikely to harbour errors.