Question

I have the following code:

Function TruncateString(str, n)
    ' Returns an array with strings no more than n char long, truncated at spaces
    Dim truncatedArr() As String
    If str <> "" Then
            str = remove_spaces_left(str)
        For i = 0 To (CLng(Len(str) / n))
            Index = InStrRev(Left(str, n), " ")
            ReDim Preserve truncatedArr(i)
            truncatedArr(i) = Left(str, Index)
            If Right(truncatedArr(i), 1) = " " Then truncatedArr(i) = Left(truncatedArr(i), Len(truncatedArr(i)) - 1)
            str = Right(str, Len(str) - Index)
        Next i
    End If
    TruncateString = truncatedArr
End Function

My question is what is the value returned by the function when str is empty? I have a type compatibility issue when I do
arr = TruncateString (text,15)

arr is defined like this:
dim arr() as string

please let me know if more info is needed for an answer. Thanks

Answer 1

I thought this was an interesting coding task, below are two attempts of mine to write a more efficient function that “chops up” a large string by

• Space [CHR(32)]
• then into fixed lengths

• then with any residual length carried over

  1. My preferred method uses a rexexp to break the string up immediately
  2. The second method runs 3 string manipulations and to me feels uglier and more complex
     • uses Split to separate the string into smaller text chunks using a space character as a delimiter
     • loops through each element of this array and breaks this up into fixed length chucks using Mid$
     • tests if any strings less than the desired fixed length chunks are left (with a Mod test), if so appends these partial strings to the final outcome

Both functions return an array by splitting the final text, which I then have returned as a single string using Join in my master sub.

Code

Sub Test()
    Dim strIn As String
    Dim lngChks As Long
    strIn = Application.Rept("The quick fox jumped over the lazy dog", 2)
    lngChks = 2
    MsgBox Join(TruncateRegex(strIn, lngChks), vbNewLine)
    MsgBox Join(TruncateMid(strIn, lngChks), vbNewLine)
End Sub

1 – Regexp

Function TruncateRegex(ByVal strIn, ByVal lngChks)
    Dim objRegex As Object
    Dim objRegMC As Object
    Dim objRegM As Object
    Dim strOut As String
    Dim lngCnt As Long
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Pattern = "[^\s]{1," & lngChks - 1 & "}(\s+|$)|[^\s]{" & lngChks & "}"
        .Global = True
        'test to avoid nulls
        If .Test(strIn) Then
            Set objRegMC = .Execute(strIn)
            For Each objRegM In objRegMC
                'concatenate long string with (short string & short string)
                strOut = strOut & (objRegM & vbNewLine)
            Next
        End If
    End With
    TruncateRegex = Split(strOut, vbNewLine)
End Function

2-String

Function TruncateMid(ByVal strIn, ByVal lngChks)
    Dim arrVar
    Dim strOut As String
    Dim lngCnt As Long
    Dim lngCnt2 As Long
    'use spaces to delimit string array
    arrVar = Split(strIn, Chr(32))
    For lngCnt = LBound(arrVar) To UBound(arrVar)
        If Len(arrVar(lngCnt)) > 0 Then
            lngCnt2 = 0
            For lngCnt2 = 1 To Int(Len(arrVar(lngCnt)) / lngChks)
                strOut = strOut & (Mid$(arrVar(lngCnt), (lngCnt2 - 1) * lngChks + 1, lngChks) & vbNewLine)
            Next
            'add remaining data at end of string < lngchks
             If Len(arrVar(lngCnt)) Mod lngChks <> 0 Then strOut = strOut & (Mid$(arrVar(lngCnt), (lngCnt2 - 1) * lngChks + 1, Len(arrVar(lngCnt)) Mod lngChks) & vbNewLine)
        End If
    Next
    TruncateMid = Split(strOut, vbNewLine)
End Function