CODEWITHSUNDEEP
vbaexcel
Sseast
Sseast

Reputation: 1

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

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
  1. Input:
    • Desmond Hume-Jack Shepard
    • Kate Austen
    • John Locke-James Ford-Hugo Reyes

Would become

  1. Output:
    • Hugo Reyes
    • James Ford
    • John Locke
    • Kate Austen
    • Jack Shepard
    • Desmond Hume

Thank you for your help :)

Upvotes: 0

Views: 43

Answers (3)

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60224

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

enter image description here

Upvotes: 1

TXP
TXP

Reputation: 59

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

Upvotes: 1

Foxfire And Burns And Burns
Foxfire And Burns And Burns

Reputation: 11978

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.

  1. Changed cell from Variant to Range
  2. In the line Cell1 = Split(Cell.Value) you forgot the second argument of that method. I added it like Cell1 = Split(Cell.Value, "-")
  3. And finally used Cells(1, 2).Value = Cell1(i) to call the array value.

Upvotes: 1

Related Questions