Split string by chars at the closest space before chunk-CodePudding

I am more than a beginner. Cutting and pasting from various solution, I built up the following code to split a string (which may have a varible number of chars, let's say from 50 to 1000) to an array. I need the chunks to be no more than 100 chars, and splitted at the closest space before 100 (no cuts in the middle of the words). The loop functions only the first time, cutting at the closest space before 100, then if more than one split is needed, it starts chunking between words. Anyone could help?

Function SplitString(ByVal str As String, ByVal numOfChar As Long) As String()

    Dim sArr() As String
    Dim nCount As Long
Dim x As Integer
    ReDim sArr((Len(str)) \ numOfChar)
   
   


    
    While Not Mid(str, x, 1) = " "
      x = x - 1
    Wend


    Do While Len(str)
        sArr(nCount) = Left$(str, x)
        str = Mid$(str, x   1)
        nCount = nCount   1
        
    Loop
    SplitString = sArr
    
    
End Function

CodePudding user response：

What you want to do can be achieved with a single loop.

To make life easier I've used the ArrayList as the vehicle for storing substrings.

The code below splits the input string into individual substrings, and then reassembles arraylists of substrings that fit the criteria of being less than a certain size.

You end up with an ArrayList of ArrayLists

Option Explicit

' This code uses the ArrayList object and thus requires a reference to msCorlib.dll
' e.g. Tools.References, scrolldown and check the tickbox for mscorlib.dll

' We use the ArrayList because it has a 'ToArray' Method and we don't have to worry
' about resizing arrays

' We return an ArrayList because this allows for more flexibility in subsequent processing
' To get a string back from myAL use    VBA.Join(myAL(x).ToArray, " ")

Public Function SplitString(ByRef ipString As String, Optional ByVal ipSize As Long = 100) As ArrayList

    Dim myAL As ArrayList
    Set myAL = New ArrayList
    Set SplitString = myAL
    
    If VBA.Len(ipString) = 0 Then
        Exit Function
    End If
    
    Dim myStrings As Variant
    myStrings = VBA.Split(ipString, " ")
    
    Dim mySize As Long
    Dim myString As Variant
    Dim myInnerList As ArrayList
    Set myInnerList = New ArrayList
    For Each myString In myStrings
    
        ' The  1 accounts for the fact that we will reassemble strings with spaces between
        ' and ensures that the reassembled string will not exceed ipSize
        If mySize   VBA.Len(myString)   1 > ipSize   1 Then
        
            myAL.Add myInnerList
            Set myInnerList = New ArrayList
            mySize = 0
            
        End If
        
        myInnerList.Add myString
        mySize = mySize   VBA.Len(myString)
            
    Next

End Function

I've not tested this code, but have checked with Rubberduck and there are no issues.

CodePudding user response：

Please, try the next code. It returns an array of strings, no longer then numOfChar, but ending where a space exists:

Function SplitString_(ByVal str As String, ByVal numOfChar As Long) As String()
    Dim strArr() As String, strElem As String, firstChar As Long, elimChars As Long, i As Long, k As Long
    Const maxLimit As Long = 100
    
    If numOfChar > maxLimit Then Exit Function 'not allowing splitting for more than 100 characters
    firstChar = 1
    ReDim strArr(Int(Len(str) / numOfChar)   2) 'redim it at a maximum number of elements, to accept maximum of needed strings
    If Len(str) > numOfChar Then                              'split only if is the case:
        For i = 1 To UBound(strArr)
            strElem = Mid(str, firstChar, numOfChar)
            If firstChar   Len(strElem) - 1 = Len(str) Then   'condition to exit function when the last necessary element has been found
                strArr(k) = strElem: ReDim Preserve strArr(k) 'preserving the array content before returning (to eliminate the empty elements)
                SplitString_ = strArr: Exit Function
            End If
            If Mid(str, Len(strElem)   Len(Join(strArr, ""))   firstChar, 1) = " " Then 'process the case when AFTER the obtained string IS a space:
                strArr(k) = strElem: k = k   1: firstChar = firstChar   Len(strElem)   1: strElem = ""
            ElseIf Right(strElem, 1) = " " Then                            'process the case when the obtaind string ends in a space
                strArr(k) = left(strElem, Len(strElem) - 1)
                k = k   1: firstChar = firstChar   Len(strElem): strElem = ""
            Else                                                            'the rest of possibilities
                'go back to the first space:
                elimChars = Len(strElem) - InStrRev(strElem, " ")   1
                strArr(k) = left(strElem, Len(strElem) - elimChars)
                k = k   1: firstChar = firstChar   Len(strElem) - elimChars   1: strElem = ""
            End If
        Next i
    Else
      ReDim strArr(0): strArr(0) = str 'return an array of a single element
    End If
End Function

You can test it with the next Sub and its stupid string:

Sub testSplitString_()
   Dim x As String, arr() As String
   x = "my string to be tested and something more should to be achieved and blah, blah, blah to the sky and more"
   arr = SplitString_(x, 20)
EndSub