Splitting a string out in a cell into 60 character chunks

[laundon]

Hello!

I have a problem that I would like help solving if I may. I have a spreadsheet that has a cell containing a string of text. I need to split this cell into 60 character chunks, preserving whole words if at all possible. The maximum cell length I have is 240 characters so I'll need to split my single cell into up to 4 separate cells of 60 characters.

Am I asking the impossible, or is this doable in Excel?

Any advice/help greatly appreciated!

Kind Regards,
Tim.

 

[mohadin]

Hi
just replace

Offset(x, 1)

with

Offset(,x)

In two places

 

[footoo]

Hi
just replace

Offset(x, 1)

with

Offset(,x)

In two places

Also, need to assign value of 1 to x, before the loop.

 

[mohadin]

Ok
Cheers

 

[rajeshrikant]

Awesome. I am touched by your quick response. Thanks a ton.

However, it would be even great, if we could run it on multiple cells. I am sure, you must tried that too.

Thanks again.

 

[rajeshrikant]

Sub v()
Dim ray() As String, i%, ns$, x%
If Selection.Count > 1 Then
    MsgBox "select one cell only."
    Exit Sub
End If
ray = Split(WorksheetFunction.Trim(Selection), " ")
ns = ray(0)
x = 1
For i = 1 To UBound(ray)
    If Len(ns) + Len(ray(i)) + 1 < 60 Then
        ns = ns & " " & ray(i)
    Else
        Selection.Offset(0, x).Value = ns
        ns = ray(i)
        x = x + 1
    End If
Next
Selection.Offset(0, x) = ns
End Sub

This works amazingly well. Thank a ton for sharing. However, is there a way to run it on multiple cells simultaneously.

 

[mohadin]

Try

Sub v()
    Dim ray() As String, i%, ii%, ns$, x%
    For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        ray = Split(Trim(Cells(ii, 1)), " ")
        ns = ray(0)
        x = 1
        For i = 1 To UBound(ray)
            If Len(ns) + Len(ray(i)) + 1 < 60 Then
                ns = ns & " " & ray(i)
            Else
                Cells(ii, 1).Offset(, x).Value = ns
                ns = ray(i)
                x = x + 1
            End If
        Next
        Cells(ii, 1).Offset(, x) = ns
    Next
End Sub

 

[rajeshrikant]

Try

Sub v()
    Dim ray() As String, i%, ii%, ns$, x%
    For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        ray = Split(Trim(Cells(ii, 1)), " ")
        ns = ray(0)
        x = 1
        For i = 1 To UBound(ray)
            If Len(ns) + Len(ray(i)) + 1 < 60 Then
                ns = ns & " " & ray(i)
            Else
                Cells(ii, 1).Offset(, x).Value = ns
                ns = ray(i)
                x = x + 1
            End If
        Next
        Cells(ii, 1).Offset(, x) = ns
    Next
End Sub

Subscript out of range error
for following
ns = ray(0)

 

[mohadin]

So you have empty row/s?

Sub v()
    Dim ray() As String, i%, ii%, ns$, x%
    For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        ray = Split(Trim(Cells(ii, 1)), " ")
        ns = ray(0)
        x = 1
        For i = 1 To UBound(ray)
            If Len(ns) + Len(ray(i)) + 1 < 60 Then
                ns = ns & " " & ray(i)
            Else
                Cells(ii, 1).Offset(, x).Value = ns
                ns = ray(i)
                x = x + 1
            End If
        Next
        Cells(ii, 1).Offset(, x) = ns
    Next
End Sub

 

[rajeshrikant]

So you have empty row/s?

Sub v()
    Dim ray() As String, i%, ii%, ns$, x%
    For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        ray = Split(Trim(Cells(ii, 1)), " ")
        ns = ray(0)
        x = 1
        For i = 1 To UBound(ray)
            If Len(ns) + Len(ray(i)) + 1 < 60 Then
                ns = ns & " " & ray(i)
            Else
                Cells(ii, 1).Offset(, x).Value = ns
                ns = ray(i)
                x = x + 1
            End If
        Next
        Cells(ii, 1).Offset(, x) = ns
    Next
End Sub

I have empty rows only at the end of the the data, not in between.

 

[rajeshrikant]

So you have empty row/s?

Sub v()
    Dim ray() As String, i%, ii%, ns$, x%
    For ii = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        ray = Split(Trim(Cells(ii, 1)), " ")
        ns = ray(0)
        x = 1
        For i = 1 To UBound(ray)
            If Len(ns) + Len(ray(i)) + 1 < 60 Then
                ns = ns & " " & ray(i)
            Else
                Cells(ii, 1).Offset(, x).Value = ns
                ns = ray(i)
                x = x + 1
            End If
        Next
        Cells(ii, 1).Offset(, x) = ns
    Next
End Sub

This one works well. Thanks a lot.