Split a cell and insert its content one cell above the other - vba

Question

I am trying to write a VBA command in order to split a cell content and insert everything it contains, one cell above the other.
Sub SplitInsert()
Dim Cell As Variant
Dim Cell1 As Variant
Dim i As Integer
'Input column is on column A that I manually select'
'Then I press plau'
For Each Cell In Selection
'I split the current selected cell into a variant tab'
Cell1 = Split(Cell.Value)
'Then I do a second loop to insert every Cell1 values'
'one after the other in column B'
For i = 0 To UBound(Cell1)
'I don't know how to insert and shift down just a cell,'
'and not a row or a column'
Cells(2, 1).Insert '....' shift:=xlShiftDown
Next
Next Cell
End Sub
Input:
Desmond Hume-Jack Shepard
Kate Austen
John Locke-James Ford-Hugo Reyes
Would become
Output:
Hugo Reyes
James Ford
John Locke
Kate Austen
Jack Shepard
Desmond Hume
Thank you for your help :)

Answer 1

Sub Macro2()
Dim Cell As Range
Dim Cell1 As Variant
Dim i As Integer
'Input column is on column A that I manually select'
'Then I press plau'
For Each Cell In Selection
'I split the current selected cell into a variant tab'
Cell1 = Split(Cell.Value, "-")
'Then I do a second loop to insert every Cell1 values'
'one after the other in column B'
For i = 0 To UBound(Cell1)
'I don't know how to insert and shift down just a cell,'
'and not a row or a column'
Cells(1, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 2).Value = Cell1(i)
Next i
Next Cell
End Sub
Try it and adap it to your needs. I made some changes yo your code, but you were on the right way.
Changed cell from Variant to Range
In the line Cell1 = Split(Cell.Value) you forgot the second
argument of that method. I added it like Cell1 = Split(Cell.Value,
"-")
And finally used Cells(1, 2).Value = Cell1(i) to call the array
value.

Answer 2

I didn't get exactly what you meant by "one cell above the other". So maybe Foxfire And Burns And Burns answered it how you wanted it to be.
My code would insert the result in B and insert a line to have a structured view in output. I also changed some things in your code and tried to comment behind the code for a better understanding of what it does.
Sub SplitInsert()
Dim Cell As Variant
Dim Cell1 As Variant
Dim i As Integer, j As Integer
Dim rng As Range
Set rng = Selection ' get selection range
j = Selection.Row ' get first selected row
For Each Cell In rng ' perform for each on every cell in range
Cell1 = Split(Cell.Value, "-") ' added separator (I assume it's what you'd want to split?)
For i = 0 To UBound(Cell1)
If i > 0 Then Rows(j).Insert ' only insert line if it's not the first value
Cells(j, 2).Value = Cell1(i) ' insert value in B
j = j + 1 ' increase row counter
Next i
Next Cell
End Sub

Answer 3

It takes a lot of time to read/write to/from the worksheet. Not a problem for a small list, but can be a problem for a large list.
The following code avoids that
Read the source data into a variant array
split each item and enter, sequentially, into a collection object
create a results array and populate from the collection in reverse order
write the results array back to the worksheet
Option Explicit
Sub SplitNames()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes() As Variant
Dim cNames As Collection
Dim V As Variant
Dim I As Long, J As Long
'Set results and source worksheets and ranges
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet1")
Set rRes = wsRes.Cells(1, 5)
'read source data into array
'you could use vSrc=Selection instead of determining the range as below
'the code below assumes the data is in column A starting at A1
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
'split the names and read them into collection
Set cNames = New Collection
For I = 1 To UBound(vSrc, 1)
V = Split(vSrc(I, 1), "-")
For J = 0 To UBound(V)
cNames.Add V(J)
Next J
Next I
'create results array in reverse order
ReDim vRes(1 To cNames.Count, 1 To 1)
For I = 1 To cNames.Count
vRes(cNames.Count + 1 - I, 1) = cNames(I)
Next I
'write the results
Set rRes = rRes.Resize(rowsize:=UBound(vRes, 1))
With rRes
.EntireColumn.Clear
.Value = vRes
.EntireColumn.AutoFit
End With
End Sub