Need help splitting large text field into 80 character fields (trickier than it sounds)

[bkaehny]

I have a text field that contains anywhere from 0 to ~1,200 characters. I need to break this up into fields containing no more than 80 characters, but I don't want to split up words when I do this. So if the 80th character comes in the middle of the word "cool" then I need to include the text " cool" in the next field.

Can anyone think of a good way to do this? I can easily split of the field into 80-character fields, but my problem is the word splitting. Thanks in advance for any help you can provide.

 

[shg]

Here's a UDF:

Function SplitStrWords(ByVal sInp As String, iMaxChars As Integer) As Variant
    ' shg 2007
    ' UDF only!
    ' Returns an array parsing the input string at word boundaries
    ' with not more than iMaxChars per substring
    Dim asWd()  As String
    Dim iWd     As Integer
    Dim nWd     As Integer
    Dim asOut() As String
    Dim iOut    As Integer
    Dim sCAR    As String
 
    sInp = Replace(sInp, Chr(160), " ")
    sInp = WorksheetFunction.Trim(sInp) & " "
    ReDim asOut(1 To Application.Caller.Cells.Count)
 
    asWd = Split(sInp)
    nWd = UBound(asWd)
 
    Do
        Do While Len(sCAR) + 1 + Len(asWd(iWd)) < iMaxChars And iWd < nWd
            sCAR = sCAR & " " & asWd(iWd)
            iWd = iWd + 1
        Loop
        iOut = iOut + 1
        asOut(iOut) = Mid(sCAR, 2)
        sCAR = vbNullString
    Loop While iWd < nWd
 
    With Application.Caller
        If .Rows.Count > .Columns.Count Then
            SplitStrWords = WorksheetFunction.Transpose(asOut)
        Else
            SplitStrWords = asOut
        End If
    End With
End Function

For example, put this in A1:

On the Insert tab, the galleries include items that are designed to coordinate with the overall look of your document. You can use these galleries to insert tables, headers, footers, lists, cover pages, and other document building blocks. When you create pictures, charts, or diagrams, they also coordinate with your current document look. You can easily change the formatting of selected text in the document text by choosing a look for the selected text from the Quick Styles gallery on the Home tab. You can also format text directly by using the other controls on the Home tab. Most controls offer a choice of using the look from the current theme or using a format that you specify directly.

Select A2:A12, and array-enter

=SplitStrWords(A1, 80)

to see

       --------------------------------------A---------------------------------------
   2   On the Insert tab, the galleries include items that are designed to coordinate
   3   with the overall look of your document. You can use these galleries to insert 
   4   tables, headers, footers, lists, cover pages, and other document building     
   5   blocks. When you create pictures, charts, or diagrams, they also coordinate   
   6   with your current document look. You can easily change the formatting of      
   7   selected text in the document text by choosing a look for the selected text   
   8   from the Quick Styles gallery on the Home tab. You can also format text       
   9   directly by using the other controls on the Home tab. Most controls offer a   
  10   choice of using the look from the current theme or using a format that you    
  11   specify directly.

 

[shg]

Do-over:

Function SplitWords(sInp As String, iMax As Long) As Variant
    ' shg 2011
    
    Dim asOut()     As String
    Dim nOut        As Long
    
    ' UDF only -- UDF wrapper for asSplitWords
    asOut = asSplitWords(sInp, iMax)
 
    With Application.Caller
        nOut = .Rows.Count * .Columns.Count
        ReDim Preserve asOut(1 To nOut)
        If .Rows.Count > .Columns.Count Then
            SplitWords = WorksheetFunction.Transpose(asOut)
        Else
            SplitWords = asOut
        End If
    End With
End Function
 
Function asSplitWords(ByVal sInp As String, iMax As Long) As String()
    ' shg 2011
 
    ' Returns a 1-based array parsing the input string at word
    ' boundaries (spaces), with not more than iMax characters per
    ' substring. (Returns longer substrings if sInp has insufficient
    ' spaces.)
 
    Dim asOut()     As String
    Dim iOut        As Long
    Dim iPos        As Long
 
    sInp = Replace(sInp, Chr(160), " ")
    sInp = WorksheetFunction.Trim(sInp) & " "
    ReDim asOut(1 To Len(sInp) - Len(Replace(sInp, " ", "")))
 
    Do While Len(sInp)
        iPos = InStrRev(sInp, " ", iMax)
        If iPos = 0 Then iPos = InStr(sInp, " ")
        iOut = iOut + 1
        asOut(iOut) = Left(sInp, iPos - 1)
        sInp = Mid(sInp, iPos + 1)
    Loop
 
    ReDim Preserve asOut(1 To iOut)
    asSplitWords = asOut
End Function

 

[bkaehny]

What's different about your second reply? I tried the first code you gave me, and it worked great.

 

[shg]

it worked great

Happy to hear it, thanks.

What's different about your second reply?

Four years more experience in writing VBA

 

[laura holmes]

Do I put it in as if it were a macro?