Results 1 to 3 of 3

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

  1. #1
    Junior Member
    Join Date
    Nov 2014
    Posts
    3
    Rep Power
    0

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

    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:
    Code:
    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

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  3. #3
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,401
    Rep Power
    10
    Try this

    Code:
    Sub CallSpliter()
    
         SplitText Worksheets("Sheet1").Range("A1:A100")
        
    End Sub
    Sub SplitText(ByRef rngSource As Range)
    
    
        Const clngSplitLen As Long = 50
        Const clngMaxSplits As Long = 99
        Dim strText As String
        Dim strBreakPoints(1 To clngMaxSplits) As String
        Dim lngSplitsCounter As Long
        Dim lngIndex As Long
        Dim rngCell As Range
        
        For Each rngCell In rngSource
            strText = Trim(rngCell.Value)
            strBreakPoints(1) = strText
            Do While Len(strText) > clngSplitLen
                lngSplitsCounter = lngSplitsCounter + 1
                If Mid(strText, clngSplitLen + 1, 1) = " " Then
                    strBreakPoints(lngSplitsCounter) = Left(strText, clngSplitLen)
                    strText = Trim(Mid(strText, clngSplitLen + 1))
                Else
                    lngIndex = InStrRev(Left(strText, clngSplitLen), " ")
                    strBreakPoints(lngSplitsCounter) = Trim(Left(strText, lngIndex))
                    strText = Trim(Mid(strText, lngIndex + 1))
                    strBreakPoints(lngSplitsCounter + 1) = strText
                End If
            Loop
            rngCell.Offset(, 1).Resize(, lngSplitsCounter + 1).Value = strBreakPoints
            strText = vbNullString
            lngSplitsCounter = Empty
            Erase strBreakPoints
        Next rngCell
        Set rngCell = Nothing
        
    End Sub
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

Similar Threads

  1. Replies: 10
    Last Post: 09-11-2014, 01:58 AM
  2. Remove Special Characters From Text Or Remove Numbers From Text
    By Excel Fox in forum Excel and VBA Tips and Tricks
    Replies: 5
    Last Post: 05-31-2013, 04:43 PM
  3. Extract Certain Characters From A Text String
    By bobkap in forum Excel Help
    Replies: 5
    Last Post: 05-24-2013, 06:25 AM
  4. Replies: 10
    Last Post: 12-10-2012, 11:28 PM
  5. Replies: 6
    Last Post: 09-26-2011, 07:39 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •