Split Data in Table To Multiple Rows Based On Delimited Text In Columns
Hi,
I keep receiving error using this vba. I edited the code you provided to suit my worksheet to best of my knowledge.
Code:
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:
HTML Code:
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.
Code:
Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert (xlShiftDown)
Thanks.
