Split Column by Delimiter into row below and keep column values - VBA

[JamesJones25]

Hello,
I am in need of VBA code for some 3000 rows that Splits the names and ID in "E" in a new row below while keeping those other column values the same. Any help would be much appreciated!!
Thank you!

Ex.
Before

After

 

[Rick Rothstein]

Give this macro a try...

Sub RedistributeData()
  Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
  Const Delimiter As String = vbLf
  Const DelimitedColumn As String = "E"
  Const TableColumns As String = "A:E"
  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) > 0 Then
      Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown
    End If
    If Len(Cells(X, DelimitedColumn)) Then
      Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
    End If
  Next
  LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
  On Error Resume Next
  Set Table = Intersect(Columns(TableColumns), Rows(StartRow).Resize(LastRow - StartRow + 1))
  If Err.Number = 0 Then
    Table.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    Columns(DelimitedColumn).SpecialCells(xlFormulas).Clear
    Table.Value = Table.Value
  End If
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub

Note
==============
It is hard to tell from your picture if there is one or two LineFeed characters between the names in Column E. I assumed one but if it is actually two, then you need to change this line of code...

Const Delimiter As String = vbLf

to this...

Const Delimiter As String = vbLf & vbLf

 

[JamesJones25]

Give this macro a try...

Mr. Rothstein, you sir are truly an Excel MVP. I can't thank you enough. Bless your heart

 

[alansidman]

Cannot manipulate data in a picture. Please upload your sample using XL2BB

 

[Rick Rothstein]

@JamesJones25
Not sure what you did, but somehow your response to me got bundled with an extra copy of my code and lost within the copy. If, as you comment suggests, my code solved your problem you should mark Message #2 as the "Answer" so others will know you no longer need any help.

 

[Peter_SSs]

but somehow your response to me got bundled with an extra copy of my code and lost within the copy.

I have tidied that up by removing most since there is nothing gained by repeating the code.