Split text separated by multiple blank spaces into multiple columns

Question

I need to split the text contents of some cells into multiple columns.

The text inside the cells doesn't follow a precise pattern (e.g. a comma, semicolon...) but the pieces of text are separated by multiple blank spaces. Here is an example:

Hi my name is Andrea (multiple blank spaces) I am good (multiple blank spaces) What about you?

I would like to split my text into three columns (one containing Hi my name is Andrea, the second containing I am good …).

The blank spaces between the sentences are not always the same (e.g. between Andrea and I am good there are 5 blank spaces while between good and what about you there are 7 blank spaces).

I thought that splitting the text when meeting more than one blank space could be a good idea. This is the code I tried:

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

You can use the following to split your string into multiple columns

Dim rng As Range
Dim txt As String
Dim FullName() As String
Dim i As Long, colOffset As Long

Set rng = ActiveCell
txt = rng.Value2

FullName = Split(txt, String(2, " "))

For i = LBound(FullName) To UBound(FullName)
    If Not WorksheetFunction.Trim(FullName(i)) = vbNullString Then
        Debug.Print WorksheetFunction.Trim(FullName(i))
        colOffset = colOffset + 1
        rng.Offset(0, colOffset).Value2 = WorksheetFunction.Trim(FullName(i))
    End If
Next i

outputting:

• Hi my name is Andrea
• I am good
• What about you?

Answer 2

It would work with double space as delimiter. In combination with using Trim$() to remove left over spaces (eg. odd number of spaces is given the double space as delimiter results in a left over space in the begining of the following data).

Option Explicit

Public Sub NameSplit()
    Dim Cell As Range
    Set Cell = Range("A1")

    Dim SplitData() As String
    SplitData = Split(Expression:=Cell.Value, Delimiter:="  ") 'double space as delimiter

    Dim i As Long, j As Long
    For i = LBound(SplitData) To UBound(SplitData)
        If Trim$(SplitData(i)) <> vbNullString Then
            Cell.Offset(ColumnOffset:=j).Value = Trim$(SplitData(i))
            j = j + 1
        End If
    Next i
End Sub

It will turn

into

If you need to do it for multiple cells wrap the code into a loop.

For iRow = 1 To LastRow
    Set Cell = Cells(iRow, "A")
    ' …
Next iRow