• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 311
  • Last Modified:

How do I separate a sentence in Microsoft Excel into smaller peaces?

I have a large  sentences in a column and i want separate them to smaller pieces that do not exceed a specific amount of characters. Worlds should not be affected.

For example lets say that I have the cells:

[A wiki enables communities to write documents collaboratively, using a simple markup language and a web browser.]
[There are many different ways in which wikis have users edit the content.]

I want to take:

[A wiki enables communities]
[to write documents collaboratively,]
[markup language and a web browser.]
[There are many different ways in which]
[wikis have users edit the content.]

These cells should not have more than 40 characters

Any Ideas?

Thank you very much.
  • 2
1 Solution
I've attached a sample file for you to test. It will split the text on cells from column  A and will put them on cells on column B with a maximum of 30 chars without breaking the words.

Function SubStrings(ByVal sInp As String, nMax As Long) As String()
    Dim iOut        As Long
    Dim iBeg        As Long
    Dim iPosNew     As Long
    Dim iPosOld     As Long
    Dim sSep        As String

    sSep = Chr(143)    ' an unused character

    sInp = Replace(sInp, Chr(160), " ")    ' change non-breaking spaces to spaces
    sInp = WorksheetFunction.Trim(sInp)

    Do Until Len(sInp) - InStrRev(sInp, sSep) <= nMax
        iBeg = iPosOld + nMax + 1
        If iBeg > Len(sInp) Then iBeg = Len(sInp)

        iPosNew = InStrRev(sInp, " ", iBeg)

        If iPosNew <= iPosOld Then
            sInp = Left(sInp, iPosOld + nMax) & sSep & Mid(sInp, iPosOld + nMax + 1)
            iPosOld = iPosOld + nMax + 1
            Mid(sInp, iPosNew) = sSep
            iPosOld = iPosNew
        End If

    SubStrings = Split(sInp, sSep)
End Function

Sub SplitEm()
    Const MaxLen    As Long = 30
    Dim cell        As Range
    Dim astr()      As String

    For Each cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
        astr = SubStrings(cell.Value, MaxLen)
        Select Case UBound(astr)
            Case -1
            Case 0
                cell.Offset(, 1).Value = astr(0)
            Case Else
                cell.Offset(, 1).Resize(UBound(astr) + 1).Value = WorksheetFunction.Transpose(astr)
        End Select
    Next cell
End Sub

Open in new window

panostsoAuthor Commented:
Excellent! This is exactly what I need.
Could you please provide some help on how i will insert this code to my sheet.

Thanks again
Take a look at this article that explains how to put a macro on a sheet:


And thanks for the grade... :)

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now