Wrapping a string into multiple strings

[eatraas]

Hi,

I want to wrap a string into multiple strings with a maximum length of 40 characters. Wrap it in whole words.

Is this possible?

Regards
Erwin

 

[pbaldy]

An example might help. You can certainly do this type of thing:

="Some fixed text " & VariableName & " some more fixed text"

 

[eatraas]

Sorry Paul, i was not completely clear,

F.i. the source string is 150 characters long, i want to break it up in 4 strings of maximum 40 characters and the break must be on whole words.

Regards
Erwin

 

[theDBguy]

Sorry Paul, i was not completely clear,

F.i. the source string is 150 characters long, i want to break it up in 4 strings of maximum 40 characters and the break must be on whole words.

Regards
Erwin

Closest thing I could think of is to use the Split() function.

 

[pbaldy]

I'll get out of the way.

 

[CJ_London]

an alternative perhaps something like

tmpstr=left(sourcestr,40)
str1=left(tmpstr,instrrev(tmpstr," "))
tmpstr=mid(sourcestr,len(str1),40)
str2=left(tmpstr,instrrev(tmpstr," "))
tmstr=mid(sourcestr,len(str1 & " " & str2),40)
etc

 

[neuroman9999]

F.i. the source string is 150 characters long, i want to break it up in 4 strings of maximum 40 characters and the break must be on whole words.

pardon my intrusion, but the requirement still isn't clear. a MAX of 40 chars? unless you've got a literal understanding of what's in the entire string now, CJ's solution might not always work.

or....maybe I'm just losing it. after, how long I've been doing this? 20 years? certainly not as long as @The_Doc_Man though.

 

[Auntiejack56]

Couldn't resist ....

Function goAuntieJack()
Const BigString = "The quick brown fox jumps over the lazy dog. Jumpy zebra vows to quit thinking coldy of sex. Bob, Carol, Ted and Alice race forwards to Jason's pink zombie quins."
Dim n As Long, arrStrings, Lastn As Long, strPrune As String

    strPrune = BigString & " "
    Do Until Len(strPrune) < 41
        For n = 1 To Len(strPrune)
            If Mid(strPrune, n, 1) = " " Then
                If n > 40 Then
                    If IsArray(arrStrings) Then
                        ReDim Preserve arrStrings(UBound(arrStrings) + 1)
                    Else
                        ReDim arrStrings(0)
                    End If
                    arrStrings(UBound(arrStrings)) = Mid(strPrune, 1, Lastn)
                    strPrune = Mid(strPrune, Lastn + 1)
                    n = 0
                    Lastn = 0
                Else
                    Lastn = n
                End If
            End If
        Next
    Loop
    If Len(strPrune) > 0 Then
        If IsArray(arrStrings) Then
            ReDim Preserve arrStrings(UBound(arrStrings) + 1)
        Else
            ReDim arrStrings(0)
        End If
        arrStrings(UBound(arrStrings)) = strPrune
    End If
    For n = 0 To UBound(arrStrings)
        Debug.Print arrStrings(n)
    Next
    
    If Trim(Join(arrStrings, "")) = Trim(BigString) Then
        Debug.Print "Hurrah!"
    End If

End Function

Then you get this in the immediate window:

The quick brown fox jumps over the lazy
dog. Jumpy zebra vows to quit thinking
coldy of sex. Bob, Carol, Ted and Alice
race forwards to Jason's pink zombie
quins.
Hurrah!

 

[CJ_London]

CJ's solution might not always work.

quite agree - which is why I didn't finish it since there are so many potential issues. Requirement is 4 strings - but perhaps the words are long so you can't split it to 4 strings, it needs more. Or perhaps there are more/less than 150 characters.

 

[The_Doc_Man]

Don't know how much effort you want to put into it, but my text parser would help you do that.

Text Parsing Support as Class Module

I've been working on something I used a lot at work to help me more easily decipher complex text inputs. For the Navy, I used this as a part of a program to analyze IIS logs, decode complex names, and I even once used a variant of this under OpenVMS to build a command-line calculator for the...

www.access-programmers.co.uk

You can use it to parse things and identify blank spaces. Then you could write a loop that consumes chunks of the input string and spits out fragments. You can concatenate the fragments until the next fragment would exceed 40 characters. So you store the previously concatenated fragments, then use the fragment that would have put you over the limit to start the next bunch of 40 characters.

This module MIGHT be a little bit of overkill, but it can do the job you request regardless of the size of the input string (as long as it will fit in a VBA string variable.)

 

[arnelgp]

same result:

'''''''''''''''''''''''
' Purpose:
'
' split a string into multiple
' string with Maximum character
' count of intMax for each
' new string. Delimeters like .,/; will be
' counted as 1 character.
'
' Parameters:
'
' pstrText      = the text to split
' pintMaxLen    = the Maximum length of new string
'
' Return:
'
' A One-based array of strings
'
Public Function SplitIntoArray(ByVal pstrText As String, ByVal pintMaxLen As Integer) As Variant
    Dim varReturn() As String
    Dim var As Variant
    Dim i As Integer, j As Integer
    Dim length As Integer
    Dim strTemp As String
    Dim strOld As String
    '* check if there is any text on the passed string
    If Len(pstrText & vbNullString) = 0 Then
        Exit Function
    End If
    '* remove extra spaces on the string.
    Do Until InStr(pstrText, "  ") = 0
        pstrText = Replace(pstrText, "  ", " ")
    Loop
    pstrText = Trim(pstrText)
    '* split the text into variable
    var = Split(pstrText, " ")
    '* allocate big array
    ReDim varReturn(1 To 50)
    For i = 0 To UBound(var)
        strOld = strTemp
        strTemp = strTemp & var(i)
        If Len(strTemp) > pintMaxLen Then
            j = j + 1
            strTemp = Trim(strOld)
            varReturn(j) = strTemp
            strTemp = var(i) & " "
        Else
            strTemp = strTemp & " "
        End If
    Next
    j = j + 1
    varReturn(j) = Trim(strTemp)
    '* remove extra elements from array
    ReDim Preserve varReturn(1 To j)
    Erase var
    SplitIntoArray = varReturn
End Function

to test:

Private Sub test()
    Const BigString = "The quick brown fox jumps over the lazy dog. Jumpy zebra vows to quit thinking coldy of sex. Bob, Carol, Ted and Alice race forwards to Jason's pink zombie quins."
    Dim var As Variant
    Dim i As Integer
    var = SplitIntoArray(BigString, 40)
    For i = 1 To UBound(var)
        Debug.Print var(i)
    Next
End Sub

 

[neuroman9999]

This module MIGHT be a little bit of overkill,

does it rival regex()???

 

[Auntiejack56]

... 30% slimmer to grab 40-ish chunks ...

Function goAuntie()
Const BigString = "The quick brown fox jumps over the lazy dog. Jumpy zebra vows to quit thinking coldy of sex. Bob, Carol, Ted and Alice race forwards to Jason's pink zombie quins."
Dim n As Long, i As Long, arrStrings, strPrune As String
    strPrune = BigString
    Do Until Len(strPrune) < 41
        If IsArray(arrStrings) Then
            ReDim Preserve arrStrings(n)
        Else
            ReDim arrStrings(n)
        End If
        arrStrings(n) = Mid(strPrune, 1, InStrRev(strPrune, " ", 41))
        strPrune = Mid(strPrune, Len(arrStrings(n)) + 1)
        n = n + 1
    Loop
    If Len(strPrune) > 0 Then
        ReDim Preserve arrStrings(n)
        arrStrings(n) = strPrune
    End If
    
    For n = 0 To UBound(arrStrings)
        Debug.Print arrStrings(n)
    Next
    
    If Trim(Join(arrStrings, "")) = Trim(BigString) Then
        Debug.Print "Hurrah!"
    End If
End Function

 

[eatraas]

Thanks guys, both the solution of arnelgp and Auntijack56 is working. Great. We will be testing both next week in a production environment.