How to split string into cells for multiple cells?

Question

I want my code to go through a list of cells containing names and split them up into the cells next to the original. I have some basic code to do the first bit, but I'm struggling to get it to cycle through the rest of my list, and also outputting it next to the original rather than in A1 as it does currently. I presume it's an issue with the 'Cell' part of the code but I can't quite fix it.

Sub NameSplit()

    Dim txt As String
    Dim i As Integer
    Dim FullName As Variant
    Dim x As String, cell As Range

    txt = ActiveCell.Value

    FullName = Split(txt, " ")

    For i = 0 To UBound(FullName)

        Cells(1, i + 1).Value = FullName(i)

    Next i


End Sub

Answer 1

Use a For Each loop on the range of name values. In this case, I just assumed they were in the first column but you can adjust accordingly:

Sub NameSplit()

Dim txt As String
Dim i As Integer
Dim FullName As Variant
Dim x As String, cell As Range

For Each cell In ActiveSheet.Range(Cells(1,1),Cells(ActiveSheet.UsedRange.Count,1))
     txt = cell.Value

     FullName = Split(txt, " ")

     For i = 0 To UBound(FullName)

         cell.offset(0,i + 1).Value = FullName(i)

     Next i

Next cell

End Sub

Answer 2

Make sure you are not trying to Split a blank cell and write all of the values in at once rather than nest a second For ... Next Statement .

Sub NameSplit()
    Dim var As Variant
    Dim rw As Long

    With Worksheets("Sheet1")   '<~~ you should know what worksheet you are on!!!!
        'from row 2 to the last row in column A
        For rw = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            'check to make the cell is not blank
            If CBool(Len(.Cells(rw, "A").Value2)) Then
                'split on a space (e.g. Chr(32))
                var = Split(.Cells(rw, "A").Value2, Chr(32))
                'resize the target and stuff the pieces in
                .Cells(rw, "B").Resize(1, UBound(var) + 1) = var
            End If
        Next rw
    End With
End Sub

If you are simply splitting on a space, have you considered a Range.TextToColumns method ?

Sub NameSplit2()
    Dim var As Variant
    Dim rw As Long

    'disable overwrite warning
    Application.DisplayAlerts = False

    With Worksheets("Sheet1")   '<~~ you should know what worksheet you are on!!!!
        'from row 2 to the last row in column A
        With .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
            'Text-to-Columns with space delimiter
            .TextToColumns Destination:=.Cells(1, 2), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, _
                    Tab:=False, Semicolon:=False, Comma:=False, Other:=False, _
                    Space:=True
        End With
    End With

    Application.DisplayAlerts = True

End Sub

Answer 3

One method is to combine a do loop with a for loop .

Do loops are a great way to iterate over items, when you are not sure at the outset how many items there are. In this case you may have more names during one execution than the next.

For loops are handy when you know in advance how many items you will be looping over. In this case we know at the start of the loop how many elements are in our names array.

The code below starts with the active cell and works its way down, until it finds an empty cell.

Sub SplitName()
' Splits names into columns, using space as a delimitor.
' Starts from the active cell.
Dim names As Variant            ' Array.  Holds names extracted from active cell.
Dim c As Integer                ' Counter.  Used to loop over returned names.

    ' Keeps going until the active cell is empty.
    Do Until ActiveCell.Value = vbNullString

        names = Split(ActiveCell.Value, Space(1))

        ' Write each found name part into a seperate column.
        For c = LBound(names) To UBound(names)

            ' Extract element to an offset of active cell.
            ActiveCell.Offset(0, c + 1).Value = names(c)
        Next

        ActiveCell.Offset(1, 0).Select  ' Move to next row.
        DoEvents                        ' Prevents Excel from appearing frozen when running over a large number of items.
    Loop
End Sub

There are several ways you could improve this proceedure.

As a general rule automation is more robust when it avoids objects like ActiveCell . This is because the user could move the active cell while your code is executing. You could refactor this procedure to accept a source range as a parameter. You could then build another sub that calculates the source range and passes it to this sub for processing. That would improve the reusability of SplitName .

You could also look into Excels Text to Columns method. This could potentially produce the desired result using fewer lines of code, which is always good.

Answer 4

Text to Columns would be a great way to do this if you can. If not here is a way to do it using arrays and a dictionary. The advantage of this is that all of the cells are read in one go and then operated on in memory before writing back the results.

Sub SplitCells()
    Dim i As Long
    Dim temp() As Variant
    Dim dict As Variant

    ' Create a dictionary
    Set dict = CreateObject("scripting.dictionary")

    ' set temp array to values to loop through
    With Sheet1
        'Declare your range to loop through
        temp = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With

    ' Split the values in the array and add to dictionary
    For i = LBound(temp) To UBound(temp)
        dict.Add i, Split(temp(i, 1), " ")
    Next i

    ' Print dictionary results
    With Sheet1.Cells(1, 2)
        For Each Key In dict.keys
            .Range(.Offset(Key - 1, 0), .Offset(Key - 1, UBound(dict.Item(Key)))) = dict.Item(Key)
        Next Key
    End With
End Sub

Output: