Split Text In To Segments Of Upto X Characters And At The Space Between Words

[BJCasler]

I have a text string, in multiple cells within a column, that I want to separate, with a maximum of 50 numbers characters per line, but the separation should only take place at a space between words.
As an example, let's say the text string is this...

blue red pink floor ground purple tied office hamburger cheese book work today tomorrow yesterday

and I want to separate it to cells to the right with no more than 50 characters in any single cell. This is how the text should look using "|" to represent the next cell (or possible where a delimiter could be placed)...


blue red pink floor ground purple tied office|hamburger cheese book work today tomorrow|yesterday


What i have is not working correctly and locking up excel. Please Help!!

Example:

Option Explicit
  
Sub termsSplit()
Dim rngData     As Range
Dim Cell        As Range
Dim arrInput()  As String
Dim arrOutput() As String
Dim strValue    As String
Dim strTmp      As String
Dim n           As Long
Dim i           As Long
Dim bContinue   As Boolean
  
  '// However you set your range//
  Set rngData = Selection '<--- using the CodeName (better IMO), or, using the sheet's
                                   '(tab) name---> ThisWorkbook.Worksheets("Sheet2").Range("A1")
  
  For Each Cell In rngData.Cells
    
    strValue = Cell.Value
    
    If Len(strValue) > 50 Then
      
      '// Split the words into an array, using the space as the delimeter.              //
      arrInput() = Split(strValue, " ")
      '// Just clarity  //
      n = 0: i = 0
      
      '// Outside loop  //
      Do While n <= UBound(arrInput)
        
        '// Empty the string and set the flag//
        strTmp = vbNullString
        bContinue = True
        
        '// Test must pass both //
        Do While n <= UBound(arrInput, 1) And bContinue
          '// If projected temp string length will be below 51... //
          If Len(strTmp) + 1 + Len(arrInput(n)) <= 51 Then
            '// ...add a space and the next word. //
            strTmp = strTmp & Chr$(32) & arrInput(n)
            n = n + 1
          Else
            '// ...else flip the flag.  //
            bContinue = False
          End If
        Loop
        
        '// Add an element to our output array and tack our built string into it. //
        i = i + 1
        ReDim Preserve arrOutput(1 To i)
        arrOutput(i) = Trim$(strTmp)
        
      Loop
      
      '// Plunk the results into a sized range //
      Cell.Offset(, 1).Resize(, UBound(arrOutput, 1)).Value = arrOutput
    
    Else
      Cell.Offset(, 1).Value = Cell.Value
    End If
    
  Next
  
End Sub