Split Sentence Into 40 Character Whole Words

sduttexcel

New Member
Joined
Mar 16, 2018
Messages
22
I have created a macro to split a column to 40 characters. The split moves to next rows but I want split to move to columns. i.e. If cell A1 is 100 characters long. The split should be B1, C1 and so on. Any help appreciated.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Code:
Sub test()
    Dim oneCell As Range
    Dim Lines As Variant
    Dim i As Long
    Dim LengthOfLine As Long
    
    LengthOfLine = 40
    With Sheet1.Range("A:A")
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            Set oneCell = .Cells(i, 1)
            With oneCell
                Lines = LInesOfLength(LengthOfLine, oneCell.Text)
                If 1 < UBound(Lines) Then
                    .Offset(1, 0).Resize(UBound(Lines) - 1, 1).EntireRow.Insert shift:=xlDown
                End If
                .Offset(0, 1).Resize(UBound(Lines), 1).Value = Application.Transpose(Lines)
            End With
        Next i
    End With
End Sub


Function LInesOfLength(ByVal LineLength As Long, ByVal aString As String) As Variant
    Dim Result() As String
    Dim FirstLine As String
    Dim LinePointer As Long
    
    aString = Trim(aString)
    If aString = vbNullString Then
        ReDim Result(1 To 1)
    Else
        ReDim Result(1 To Len(aString))
        Do
            FirstLine = Left(aString, LineLength)
            If InStr(1, FirstLine, " ") = 0 Then
                FirstLine = Split(aString, " ")(0)
            Else
                If Mid(aString, LineLength + 1, 1) = " " Or Mid(aString, LineLength + 1, 1) = vbNullString Then
                    Rem done
                Else
                    FirstLine = Left(FirstLine, InStrRev(FirstLine, " ") - 1)
                End If
            End If
            
            LinePointer = LinePointer + 1
            Result(LinePointer) = FirstLine
            aString = Trim(Replace(aString, FirstLine, vbNullString, 1, 1))
        Loop Until aString = vbNullString
        
        ReDim Preserve Result(1 To LinePointer)
        
    End If
    LInesOfLength = Result
End Function
 
Last edited by a moderator:
Upvote 0
Hi & welcome to the board.
Try
Code:
Sub test()
    Dim oneCell As Range
    Dim Lines As Variant
    Dim i As Long
    Dim LengthOfLine As Long
    
    LengthOfLine = 20
    With Sheet1.Range("A:A")
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            Set oneCell = .Cells(i, 1)
            With oneCell
                Lines = LInesOfLength(LengthOfLine, oneCell.Text)
                .Offset(0, 1).Resize(, UBound(Lines)).Value = Lines
            End With
        Next i
    End With
End Sub
 
Upvote 0
Here is a fully self-contained macro (no side function calls required) that you can consider...
Code:
[table="width: 500"]
[tr]
	[td]Sub SplitTextOnSpacesWithMaxCharactersPerLine()
  Dim Text As String, TextMax As String, SplitText As String, Answer() As String
  Dim Space As Long, Source As Range, CellWithText As Range

  Const MaxChars As Long = 40
  Const DestinationOffset As Long = 1

  Set Source = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  On Error GoTo 0
  For Each CellWithText In Source
    Text = CellWithText.Value
    SplitText = ""
    Do While Len(Text) > MaxChars
      TextMax = Left(Text, MaxChars + 1)
      If Right(TextMax, 1) = " " Then
        SplitText = SplitText & RTrim(TextMax) & vbLf
        Text = Mid(Text, MaxChars + 2)
      Else
        Space = InStrRev(TextMax, " ")
        If Space = 0 Then
          SplitText = SplitText & Left(Text, MaxChars) & vbLf
          Text = Mid(Text, MaxChars + 1)
        Else
          SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
          Text = Mid(Text, Space + 1)
        End If
      End If
    Loop
    Answer = Split(SplitText & Text, vbLf)
    CellWithText.Offset(, DestinationOffset).Resize(, UBound(Answer) + 1).Value = Answer
  Next
  Exit Sub
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Rick, SplitText = "" I've seen this a few times when people are working with string variables, is it setting the variable to some sort of array?
 
Upvote 0
Rick, SplitText = "" I've seen this a few times when people are working with string variables, is it setting the variable to some sort of array?
No, SplitText is Dim'med as a String variable, so it cannot be an array. What that line of code is doing is setting the SplitText variable to the empty text string ("") so that there is nothing in it (left over from the previous loop) as a new loop starts. Think of it a "clearing" a String variable.
 
Upvote 0
Hi & welcome to the board.
Try
Code:
Sub test()
    Dim oneCell As Range
    Dim Lines As Variant
    Dim i As Long
    Dim LengthOfLine As Long
    
    LengthOfLine = 20
    With Sheet1.Range("A:A")
        For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1
            Set oneCell = .Cells(i, 1)
            With oneCell
                Lines = [COLOR=#ff0000]LInesOfLength[/COLOR](LengthOfLine, oneCell.Text)
                .Offset(0, 1).Resize(, UBound(Lines)).Value = Lines
            End With
        Next i
    End With
End Sub

I have highlighted in red where I get error.
 
Upvote 0

Forum statistics

Threads
1,212,927
Messages
6,110,731
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top