[Solved] Splitting Excel Column into 30-Character Segments Without Cutting Words

[Ridwan]

Many Excel users need assistance in splitting a column in Excel into multiple segments, each limited to a certain number of characters, without cutting words. Suppose, I have a column in Excel (let's say Column A) with text data that needs to be divided into segments of 30 characters each. However, the challenge is to split the text intelligently, ensuring that words are not cut off in the middle. If a word exceeds the 30-character limit, it should be moved to the next segment.

For example:
Original Text: "I have a challenge in Excel where I need to split this column into multiple segments, each segment limited to 30 characters without cutting words." in Column A

The desired outcome, after splitting into 30-character segments without cutting words, could be:
Column B: "I have a challenge in Excel"
Column C: "where I need to split this"
Column D: "column into multiple segments,"
Column E: "each segment limited to 30"
Column F: "characters without cutting words."

Solution 1: Using Formulas​

Suppose, you have long sentences in column A and you want to split them in columns B, C, D.

Formula for Column B (assuming data starts from A2):

=IF(LEN(A2)<=30, A2, LEFT(A2, FIND("#", SUBSTITUTE(LEFT(A2, 31), " ", "#", LEN(LEFT(A2, 31))-LEN(SUBSTITUTE(LEFT(A2, 31), " ", ""))))-1))

Formula for Column C:

=IF(LEN(MID(A2, LEN(B2)+1, LEN(A2)))<=30, MID(A2, LEN(B2)+1, LEN(A2)), LEFT(MID(A2, LEN(B2)+1, LEN(A2)), FIND("#", SUBSTITUTE(LEFT(MID(A2, LEN(B2)+1, LEN(A2)), 31), " ", "#", LEN(LEFT(MID(A2, LEN(B2)+1, LEN(A2)), 31))-LEN(SUBSTITUTE(LEFT(MID(A2, LEN(B2)+1, LEN(A2)), 31), " ", ""))))-1))

Formula for Column D:

=TRIM(SUBSTITUTE(A2, TRIM(B2 & " " & C2), ""))

Solution 2: Using VBA Code​

Here is a VBA macro that can be used to achieve the same result:

Sub SplitColumn()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim splitText() As String
    Dim result() As String
    Dim i As Integer, j As Integer
 
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to your sheet name
 
    ' Find the last row with data in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
    ' Loop through each cell in column A
    For Each cell In ws.Range("A1:A" & lastRow)
    
        ' Check if the cell is empty
        If IsEmpty(cell.Value) Then
            Exit For ' Exit the loop if an empty cell is encountered
        End If
    
        ' Split the text into an array of words
        splitText = Split(cell.Value, " ")
    
        ' Initialize variables for the result array
        ReDim result(1 To Int((Len(cell.Value) - 1) / 30) + 1)
        result(1) = ""
        j = 1
    
        ' Loop through each word in the splitText array
        For i = LBound(splitText) To UBound(splitText)
            ' Check if adding the next word exceeds the 30-character limit
            If Len(result(j) & splitText(i) & " ") <= 30 Then
                ' Add the word to the current result element
                result(j) = result(j) & splitText(i) & " "
            ElseIf Len(splitText(i) & " ") <= 30 Then
                ' Move to the next result element
                j = j + 1
                ReDim Preserve result(1 To j)
                result(j) = splitText(i) & " "
            Else
                ' Handle the case where a single word exceeds the 30-character limit
                ' Split the word into multiple segments (each with a max of 30 characters)
                Do While Len(splitText(i) & " ") > 30
                    j = j + 1
                    ReDim Preserve result(1 To j)
                    result(j) = Left(splitText(i), 30) & " "
                    splitText(i) = Mid(splitText(i), 31)
                Loop
                If Len(result(j) & splitText(i) & " ") <= 30 Then
                    result(j) = result(j) & splitText(i) & " "
                Else
                    ' Handle further adjustments as needed
                End If
            End If
        Next i
    
        ' Output the result to the adjacent columns starting from column B
        For i = LBound(result) To UBound(result)
            cell.Offset(0, i).Value = Trim(result(i))
        Next i
    Next cell
End Sub