Find closest space to the left of specified position and then split

[fillefrans]

Hi!

I'm looking for a way to split a cell with text into two cells. The first cell can only contain up to 40 characters, the rest needs to go in the second cell. However, I don't want the text to be split in the middle of a word. So basically, if the text is in cell A1, I need to find the closest space to the left of position 40 in A1, and move anything to the right of this position to B1. Example:

Original text:
A1: One green apple and a bucket of small onions that smell nice

I want to avoid this:
A1: One green apple and a bucket of small on
B1: ions that smell nice

I want to achieve this:
A1: One green apple and a bucket of small
B1: onions that smell nice


Any ideas?

[mrice]

Can do this with a pair of user defined functions

Function FirstBit(MyRange As Range) As String
For N = 40 To 2 Step -1
    If Mid(MyRange, N, 1) = " " Then
        FirstBit = Left(MyRange, N - 1)
        Exit Function
    End If
Next N
End Function

Function SecondBit(MyRange As Range) As String
For N = 40 To 2 Step -1
    If Mid(MyRange, N, 1) = " " Then
        SecondBit = Mid(MyRange, N + 1)
        Exit Function
    End If
Next N
End Function

Open the VBA editor by hitting Alt F11.
Insert a new module with Insert - Module
Paste in the above function
Go back to the sheet by hitting Alt F11.

In B2, enter =FirstBit(A1)
In C2, enter =SecondBit(A1)

Remember to save the workbook as a macro enabled workbook .xlsm

[fillefrans]

Can do this with a pair of user defined functions

Function FirstBit(MyRange As Range) As String
For N = 40 To 2 Step -1
    If Mid(MyRange, N, 1) = " " Then
        FirstBit = Left(MyRange, N - 1)
        Exit Function
    End If
Next N
End Function

Function SecondBit(MyRange As Range) As String
For N = 40 To 2 Step -1
    If Mid(MyRange, N, 1) = " " Then
        SecondBit = Mid(MyRange, N + 1)
        Exit Function
    End If
Next N
End Function

Open the VBA editor by hitting Alt F11.
Insert a new module with Insert - Module
Paste in the above function
Go back to the sheet by hitting Alt F11.

In B2, enter =FirstBit(A1)
In C2, enter =SecondBit(A1)

Remember to save the workbook as a macro enabled workbook .xlsm

Fantastic, thank you very much! :D

[martindwilson]

b1 =IF(LEN(A1)<=40,A1,LEFT(A1,FIND("^",SUBSTITUTE(A1," ","^",LEN(LEFT(A1,41))-LEN(SUBSTITUTE(LEFT(A1,41)," ",""))))-1))
c1 = =TRIM(SUBSTITUTE(A1,B1,""))

[sktneer]

Another way using a macro.....

Sub SplitCellContent()
Dim rng As Range, cell As Range
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A1:A" & lr)
For Each cell In rng
    n = Len(cell.Value) - Len(WorksheetFunction.Substitute(cell.Value, " ", ""))
    For i = n To 1 Step -1
        If Len(cell.Value) > 40 Then
            m = WorksheetFunction.Find("*", WorksheetFunction.Substitute(cell.Value, " ", "*", i))
            If m <= 40 Then
                cell.Offset(0, 1).Value = Mid(cell.Value, m + 1, Len(cell.Value) - m)
                cell.Value = Left(cell.Value, m)
            End If
        End If
    Next i
Next cell
End Sub