Split Data in Table To Multiple Rows Based On Delimited Text In Columns

[nick5_86]

Hi,

I keep receiving error using this vba. I edited the code you provided to suit my worksheet to best of my knowledge.

Sub RedistributeData()
  Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
  Const Delimiter As String = ","
  Const DelimitedColumn As String = "B"
  Const TableColumns As String = "A:P"
  Const StartRow As Long = 2
  Application.ScreenUpdating = False
  LastRow = Columns(TableColumns).Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  For X = LastRow To StartRow Step -1
    Data = Split(Cells(X, DelimitedColumn), Delimiter)
    If UBound(Data) Then
      Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert (xlShiftDown)
    End If
    Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
  Next
  LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
  On Error GoTo NoBlanks
  Set Table = Intersect(Columns(TableColumns), Rows(StartRow).Resize(LastRow - StartRow + 1))
  On Error GoTo 0
  For Each A In Table.SpecialCells(xlBlanks).Areas
    A.FormulaR1C1 = "=R[-1]C"
    A.Value = A.Value
  Next
NoBlanks:
  Application.ScreenUpdating = True
End Sub

My table is somthing like this:

A                          B                                         C                                       D
L1A1                               L1B1,L1B2                             L1C1                                  L1D1,L1D2
L2A1                               L2B1,L2B2                             L2C1                                  L2D1,L2D2

I don't know where i get it wrong. When i click Debug, this line is highlighted.

Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert (xlShiftDown)

Thanks.