VBA to parse string

Hello Experts,

I have a 255 char text field that has an extended list of specifications like below.

"Choose your favorite designs and customize them with Avery Design & Print. Get labels in the shape and size of your choice to personalize your holiday shipping packages, seasonal greetings, gifts or decorations. Click design below, or view in our gallery.")

I need to split it into 5 or 6 fields like below:

"Choose your favorite designs and customize them with"
"Avery Design & Print. Get labels in the shape and size of"
"your choice to personalize your holiday shipping packages,"
"seasonal greetings, gifts or decorations. Click design below,"
"or view in our gallery."

No more than 50 characters per line.
LVL 14
Bill RossAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Russell FoxDatabase DeveloperCommented:
You can use the Split function to split each word into an array, and then construct a new array, something like the below (which is NOT tested - I scratched it out in notepad):
Option Explicit

Private Sub Command1_Click()
   Dim strTest As String
   Dim strArray() As String
   Dim strArrayNew(1) As String
   Dim intCount As Integer
   
   strText = Fields!YourMemo.value

   'split each word into an array element:
   strArray = Split(strText, " ") 
   
   For intCount = LBound(strArray) To UBound(strArray)

      ' If I can add the next strArray item to the top strArray2 item 
	  ' and still be under 50 characters, do it, otherwise create a 
	  ' new strArray2 item.
	  If Len(strArray2(UBound(strArray2)) + strArray(intCount) + " ") < 50 Then
		strArray2(UBount(strArray)) = strArray2(UBound(strArray)) + strArray(intCount) + " "
      Else
		ReDim Preserve strArray2(UBound(strArray2) + 1)
		strArray2(UBound(strArray2)) = strArray(intCount) + " "
      EndIf

   Next

   For intCount = LBount(strArray2) To UBound(strArray2)

      ' Do what you need with the new array of ~50 character lines.

   Next

End Sub

Open in new window

1
Andy CownieImplementation SpecialistCommented:
Here's a function that splits a string into an array with each element of length 50 characters, and a test function to show you how to call it and use the results.

Public Function splitString(longtext As String) As Variant
    On Error Resume Next
    Dim shortString(6) As String
    shortString(1) = Mid(longtext, 1, 50)
    shortString(2) = Mid(longtext, 51, 50)
    shortString(3) = Mid(longtext, 101, 50)
    shortString(4) = Mid(longtext, 151, 50)
    shortString(5) = Mid(longtext, 201, 50)
    shortString(6) = Mid(longtext, 251, 5)
    splitString = shortString()
End Function

Public Function test()
    Dim testa As Variant
    testa = splitString("Choose your favorite designs and customize them with Avery Design & Print. Get labels in the shape and size of your choice to personalize your holiday shipping packages, seasonal greetings, gifts or decorations. Click design below, or view in our gallery.")
    Debug.Print testa(1)
    Debug.Print testa(2)
    Debug.Print testa(3)
    Debug.Print testa(4)
    Debug.Print testa(5)
    Debug.Print testa(6)
End Function

Open in new window

0
Gustav BrockCIOCommented:
That, Andrew, would chop the words. And, as you don't use a loop, it would be further limited.

/gustav
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Bill RossAuthor Commented:
Hi Russel,

I'm getting a compile error at
ReDim Preserve strarray2(UBound(strarray2) + 1)

Also, I want to create a function, not a text box.  Not sure how to return the array values in the function.

Here is what I have so far but I'm not familiar with arrays.  This will not compile due to the ReDim error.

Public Function SplitTextIntoArray(strTest As String)
   Dim strArray() As String
   Dim strArrayNew(1) As String
   Dim intCount As Integer
   

   'split each word into an array element:
   strArray = Split(strText, " ")
   
   For intCount = LBound(strArray) To UBound(strArray)

      ' If I can add the next strArray item to the top strArray2 item
      ' and still be under 50 characters, do it, otherwise create a
      ' new strArray2 item.
      If Len(strarray2(UBound(strarray2)) + strArray(intCount) + " ") < 50 Then
        strarray2(UBound(strArray)) = strarray2(UBound(strArray)) + strArray(intCount) + " "
      Else
        ReDim Preserve strarray2(UBound(strarray2) + 1)
        strarray2(UBound(strarray2)) = strArray(intCount) + " "
      End If

   Next

   For intCount = LBound(strarray2) To UBound(strarray2)
       Debug.Print strarray2, 1
       Debug.Print strarray2, 2
       Debug.Print strarray2, 3
       Debug.Print strarray2, 4
       Debug.Print strarray2, 5
      ' Do what you need with the new array of ~50 character lines.

   Next

End Function
0
Bill RossAuthor Commented:
OK.  I'm making progress.  

I get a type mismatch error on the Split statement...  Why?

Public Function SplitTextIntoArray(strText As String)
   Dim strArray() As Variant
   Dim strArrayNew() As Variant
   Dim intCount As Integer
   
   
   'split each word into an array element:
   strArray = Split(strText, " ", -1)
   
   Debug.Print strArray(1)

...
0
Gustav BrockCIOCommented:
You can do like this:
Public Function Line50(ByVal OneLine As String) As String

    Dim Words       As Variant
    Dim Lines       As Variant
    Dim WordCount   As Integer
    Dim NextLine    As String
    Dim ManyLines   As String
    
    Words = Split(OneLine, " ")
    For WordCount = LBound(Words) To UBound(Words)
        If Len(NextLine) + Len(Words(WordCount)) < 50 Then
            If NextLine <> "" Then
                NextLine = NextLine + " "
            End If
            NextLine = NextLine + Words(WordCount)
        Else
            WordCount = WordCount - 1
            If ManyLines <> "" Then
                ManyLines = ManyLines + vbCrLf
            End If
            ManyLines = ManyLines + NextLine
            NextLine = ""
        End If
    Next
    If NextLine <> "" Then
        If ManyLines <> "" Then
            ManyLines = ManyLines + vbCrLf
        End If
        ManyLines = ManyLines + NextLine
    End If
    
    Line50 = ManyLines
    
End Function

Open in new window

Returns:
Choose your favorite designs and customize them
with Avery Design & Print. Get labels in the shape
and size of your choice to personalize your
holiday shipping packages, seasonal greetings,
gifts or decorations. Click design below, or view
in our gallery.
/gustav
0
Rey Obrero (Capricorn1)Commented:
@bill, try this. similar approach with Russel

Function SplitTextIntoArray(strTest As String)
Dim str As String, wrdArr() As String, j As Integer, lnArr() As String, idx As Integer
str = strTest

ReDim Preserve lnArr(0)
lnArr(0) = ""
wrdArr = Split(str, " ")
For j = 0 To UBound(wrdArr)
    If Len(lnArr(UBound(lnArr)) & wrdArr(j) & " ") < 56 Then
        lnArr(UBound(lnArr)) = lnArr(UBound(lnArr)) & wrdArr(j) & " "
        Else
        ReDim Preserve lnArr(UBound(lnArr) + 1)
        lnArr(UBound(lnArr)) = wrdArr(j) & " "
    End If
Next

For idx = LBound(lnArr) To UBound(lnArr)
    Debug.Print idx + 1, lnArr(idx)
Next
End Function

Open in new window

1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bill RossAuthor Commented:
OK.  More progress.  Array works now but I'm having trouble creating the new array to hold the output.  I don't understand the lines
"If Len(strArrayNew(UBound(strArray)) + strArray(intCount) + " ") < 50 Then"

Public Function SplitTextIntoArray(strText As String)
   Dim strArray As Variant
   Dim strArrayNew As Variant
   Dim intCount As Integer
   
   
   'split each word into an array element:
   strArray = Split(strText)
   
   Debug.Print strArray(1)
   
   For intCount = LBound(strArray) To UBound(strArray)
       
       
      ' If I can add the next strArray item to the top strArray2 item
      ' and still be under 50 characters, do it, otherwise create a
      ' new strArrayNew item.
     
If Len(strArrayNew(UBound(strArray)) + strArray(intCount) + " ") < 50 Then
        strArrayNew(UBound(strArray)) = strArrayNew(UBound(strArray)) + strArray(intCount) + " "
      Else
        ReDim Preserve strArrayNew(UBound(strArrayNew) + 1)
        strArrayNew(UBound(strArrayNew)) = strArrayNew(intCount) + " "
      End If
0
Bill RossAuthor Commented:
Hi Rey,

That works!  

Just for my understanding can you explain how the lines below work?

    If Len(lnArr(UBound(lnArr)) & wrdArr(j) & " ") < 56 Then
        lnArr(UBound(lnArr)) = lnArr(UBound(lnArr)) & wrdArr(j) & " "
    Else
        ReDim Preserve lnArr(UBound(lnArr) + 1)
        lnArr(UBound(lnArr)) = wrdArr(j) & " "
    End If

Thanks!!!
0
Gustav BrockCIOCommented:
Once the words are split, you can simply concatenate the lines as I've shown above.

/gustav
0
Bill RossAuthor Commented:
Specifically:

why the <56? and not <50?

And how does the ReDim work in all this?

Thanks,

Bill
0
Rey Obrero (Capricorn1)Commented:
<why the <56? and not <50?>
if you use 50, you will have 6 lines

Redim is use to dynamically allocate spaces for arrays.
for more info, click Help from your VBA window and type Redim
0
Rey Obrero (Capricorn1)Commented:
if the length of the create lnArr is less than 56 add the next element of the array wrdArr

    If Len(lnArr(UBound(lnArr)) & wrdArr(j) & " ") < 56 Then  
        lnArr(UBound(lnArr)) = lnArr(UBound(lnArr)) & wrdArr(j) & " "


    Else

create another element for lnArr and add the next element of the array wrdArr

        ReDim Preserve lnArr(UBound(lnArr) + 1)
        lnArr(UBound(lnArr)) = wrdArr(j) & " "
    End If
0
aikimarkCommented:
This FlowText() function uses the power of regular expressions to do the parsing
Function FlowText(parmString, Optional parmMaxLen = 50) As Collection
    Static oRE As Object
    Dim oMatches As Object
    Dim oM As Object
    
    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.Pattern = "(\w.{1," & parmMaxLen - 1 & "})(?: |$)"
    End If

    If oRE.test(parmString) Then
        Set oMatches = oRE.Execute(parmString)
        Set FlowText = New Collection
        For Each oM In oMatches
            FlowText.Add oM.submatches(0)
        Next
    End If
    
End Function

Open in new window

Example function test:
s="Choose your favorite designs and customize them with Avery Design & Print. Get labels in the shape and size of your choice to personalize your holiday shipping packages, seasonal greetings, gifts or decorations. Click design below, or view in our gallery."

set x=flowtext(s)

?x.count
 6 

for each vline in x: ?vline: next
Choose your favorite designs and customize them
with Avery Design & Print. Get labels in the shape
and size of your choice to personalize your
holiday shipping packages, seasonal greetings,
gifts or decorations. Click design below, or view
in our gallery.

Open in new window

0
aikimarkCommented:
Please note that this is bare bones code with no error trapping in case you pass a Null value, pass a text string with non-alphanumeric words, or specify an invalid parmMaxLen value.
0
aikimarkCommented:
@BillDenver

Did you try my code?
0
Bill RossAuthor Commented:
Great help from all.  This is the resulting function I'm using.  It splits out whichever line I need.
Thanks!!!  Bill

Function SplitTextIntoArray(strTest As String, vLineNo)
Dim str As String, wrdArr() As String, j As Integer, lnArr() As String, idx As Integer
str = strTest

ReDim Preserve lnArr(0)
lnArr(0) = ""
wrdArr = Split(str, " ")
For j = 0 To UBound(wrdArr)
    If Len(lnArr(UBound(lnArr)) & wrdArr(j) & " ") < 56 Then
        lnArr(UBound(lnArr)) = lnArr(UBound(lnArr)) & wrdArr(j) & " "
        Else
        ReDim Preserve lnArr(UBound(lnArr) + 1)
        lnArr(UBound(lnArr)) = wrdArr(j) & " "
    End If
Next
'Debug.Print UBound(lnArr)

For idx = LBound(lnArr) To UBound(lnArr)
    Debug.Print idx + 1, Len(lnArr(idx)), lnArr(idx)
Next
vLineNo = vLineNo - 1

If vLineNo > UBound(lnArr) Or vLineNo < LBound(lnArr) Then
    SplitTextIntoArray = Null
Else
    SplitTextIntoArray = lnArr(vLineNo)
End If

End Function
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

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.