Is there a way to place the cell contents separated by a comma byinserting a new line and then copyi

[anshu minocha]

Hiii,

I have a problem with the following code:

Suppose

Data:
colC Col D

Row 1 Phase SP#
Row 2 1-0210 60625IT1m,60625EO1m
Row 3 2-0210 60625IT2,60625RB2

Output obtained after running the code:

colC Col D

Row 1 Phase SP#
Row 2 1-0210 60625IT1m
Row 3 2-0210 60625EO1m
Row 4 60625IT2
Row 5 60625RB2


Output Desired:while separating the values for SP# and placing them on
new cells,
The code should be able to insert a new line and copy the cell
contents on it as shown below else it is not possible to distinguish
which SP# belong to which Phase.

colC Col D

Row 1 Phase SP#
Row 2 1-0210 60625IT1m
Row 3 60625EO1m
Row 4 2-0210 60625IT2
Row 5 60625RB2

Please help me find the flaw with the code below, Any help would be
appreciated.
Thankyou.

'Step 3:This Macro is to arrange SP# from one cell to different cells
in the column
Sub Arrange_SP()
Dim myArr As Variant
Dim CS As String 'Hold the string value of the current cell being
checked.
Dim CR As Long 'Current Row number to be checked for possible array.
Dim NR As Long 'Upper Bound element number of Array
'Lower Bound number in this instance will always be
'0'
Dim FR As Long 'First Row number of range to be checked.
Dim LR As Long 'Last Row number of range to be checked.
Dim I As Long


FR = 2
LR = 1194


For CR = FR To LR
CS = Range("D" & CR).Value 'D here indicates that our SP# column
is D in the SP Template
If InStr(1, CS, ",", 0) > 0 Then
myArr = Split(CS, ",")
NR = UBound(myArr)
Range("D" & CR).Offset(1, 0).Resize(NR, 11).Insert
(xlShiftDown)
For I = 0 To NR
Range("D" & CR + I).Value = myArr(I)
Next I
CR = CR + NR
LR = LR + NR
End If
Next CR
End Sub

Thanks