Hi
I found below code on another site that does most of what I need it to do except for a few things I would like to add if possible.
The code splits all sentence's in column A into maximum character length of 40 whole words in each sentence.
Currently the split 40 character chunks are positioned in the columns next to the original sentence. (column B, C, D etc)
What I would like to achieve if possible is for a new row(s) added below original line(s) and the 40 character chunks added in these blank rows for all sentences in column A
Is this possible ?
Any help would be much appreciated
Tks
Sub breakTextAt40()
'' Cycles through all rows in column A putting a pipe every 40 characters without breaking whole words
For i = 1 To Range("a" & Rows.Count).End(xlUp).Row 'Sets the range to cycle through
Cells(i, 1).Activate 'Selects the cell to be split. i is the row, 1 is the column
Dim str_Out As String 'Variable to hold the new text string as it is created
Dim iloop As Integer 'Used as a counter for how many words are in the current string
Dim strString As Variant 'The original string will be split into an array and placed in this holder
Dim num As Integer 'Holds the max number of characters allowed
str_Out = "" 'Set empty value to put the new text in
num = 40 'Set the max number of characters. This number will increase each time it adds a new delimiter
strString = Split(ActiveCell.Value, " ") 'Splits the text into an array
For iloop = LBound(strString) To UBound(strString) 'Sets the number of cycles that the For Loop runs based on how many elements(words) are in the array
If iloop < UBound(strString) Then 'If the count of iloop is less then the max number of words, then keep running this loop
str_Out = str_Out & strString(iloop) & " " 'Takes the current string of text, adds the next word in the array, and a Space to separate it from the next word
If (Len(str_Out) + Len(strString(iloop + 1))) > num Then
str_Out = str_Out & "|" 'If the length of the current string plus the length of the next word of the string is greater then the text limit, then don't add the next word and add a pipe instead
num = Len(str_Out) + 40 'Count the current length of the text and add 40 to it
End If
End If
Next
str_Out = Trim(str_Out) 'Trim any extra whitespace off the text string
ActiveCell.Value = str_Out 'output the edited text string into the cell that the original text was in
Next
'' Split Column A with Text to Column using Piping as delimiter
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End Sub
I found below code on another site that does most of what I need it to do except for a few things I would like to add if possible.
The code splits all sentence's in column A into maximum character length of 40 whole words in each sentence.
Currently the split 40 character chunks are positioned in the columns next to the original sentence. (column B, C, D etc)
What I would like to achieve if possible is for a new row(s) added below original line(s) and the 40 character chunks added in these blank rows for all sentences in column A
Is this possible ?
Any help would be much appreciated
Tks
Sub breakTextAt40()
'' Cycles through all rows in column A putting a pipe every 40 characters without breaking whole words
For i = 1 To Range("a" & Rows.Count).End(xlUp).Row 'Sets the range to cycle through
Cells(i, 1).Activate 'Selects the cell to be split. i is the row, 1 is the column
Dim str_Out As String 'Variable to hold the new text string as it is created
Dim iloop As Integer 'Used as a counter for how many words are in the current string
Dim strString As Variant 'The original string will be split into an array and placed in this holder
Dim num As Integer 'Holds the max number of characters allowed
str_Out = "" 'Set empty value to put the new text in
num = 40 'Set the max number of characters. This number will increase each time it adds a new delimiter
strString = Split(ActiveCell.Value, " ") 'Splits the text into an array
For iloop = LBound(strString) To UBound(strString) 'Sets the number of cycles that the For Loop runs based on how many elements(words) are in the array
If iloop < UBound(strString) Then 'If the count of iloop is less then the max number of words, then keep running this loop
str_Out = str_Out & strString(iloop) & " " 'Takes the current string of text, adds the next word in the array, and a Space to separate it from the next word
If (Len(str_Out) + Len(strString(iloop + 1))) > num Then
str_Out = str_Out & "|" 'If the length of the current string plus the length of the next word of the string is greater then the text limit, then don't add the next word and add a pipe instead
num = Len(str_Out) + 40 'Count the current length of the text and add 40 to it
End If
End If
Next
str_Out = Trim(str_Out) 'Trim any extra whitespace off the text string
ActiveCell.Value = str_Out 'output the edited text string into the cell that the original text was in
Next
'' Split Column A with Text to Column using Piping as delimiter
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
End Sub
