Split Cells?

[jcnone]

Thanks in advance for your help.
I have no VBA experience and am trying to work up a VBA macro. I have the following question:

How do I split the values in column D and place each value in a separate row along with the other data of the row as shown below?

A B C D
1 animals kitten dogs category1 (this is all in
choice2 the same row with
pick3 chr(10) seperator.)

Below is the desired result:

A B C D
1 animals kitten dogs category1
2 animals kitten dogs choice2
3 animals kitten dogs pick3


I found the following code which will output the Column D values in separate rows but it does not bring along the other row data (Columns A, B, C) as I need. How
can I modify this code to include the other row data for each "split off" value of Col D? Or, is there some other way to do it altogether?

Partial solution below? \ \ \ \ \ \ \ \

If Cell D divided by the Chr(10) character, then this will place the items

Public Sub Split()
n = 1
strt = 1
For i = 1 To Len(Selection)
If Mid(Selection, i, 1) = Chr(10) Then
Selection.Offset(n, 0) = Mid(Selection, strt, i - strt)
strt = i + 1
n = n + 1
End If
Next i
Selection.Offset(n, 0) = Mid(Selection, strt, i - strt)
End Sub

To run the above, select the cell you want to split and run the Macro (Alt F8, select Split/Run). The individual values are output below. It will overwrite anything
already there.

Any help will be appreciated.

 

[Rick Rothstein \(MVP - VB\)]

I have no idea if this is in anyway the most efficient way to do what you
asked, but the code seems to work...

Sub SplitSelectedCell()
Dim X As Long
Dim Lines() As String
Lines = Split(ActiveCell.Value, vbLf)
For X = 0 To UBound(Lines) - 1
ActiveCell.Offset(1, 0).EntireRow.Insert xlShiftDown
ActiveCell.EntireRow.Copy Destination:= _
ActiveCell.Offset(1, 1 - ActiveCell.Column)
Next
For X = 0 To UBound(Lines)
ActiveCell.Offset(X, 0).Value = Lines(X)
Next
End Sub


Rick