ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Splitting text in cells. (https://www.excelbanter.com/excel-programming/404156-splitting-text-cells.html)

Joergen Bondesen
Splitting text in cells.
 
Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

--

Best regards from
Joergen Bondesen



Bob Phillips
Splitting text in cells.
 

With ActiveCell

If Len(.Value) MaxSplitLength Then

MsgBox "Splitting to next cell in row"
.Offset(0, 1).Value = Right$(.Value, Len(.Value) -
MaxSplitLength)
.Value = Left$(.Value, MaxSplitLength)
End If
End With

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"Joergen Bondesen" wrote in message
...
Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

--

Best regards from
Joergen Bondesen

Ron Rosenfeld
Splitting text in cells.
 
On Sat, 12 Jan 2008 12:30:39 +0100, "Joergen Bondesen"
wrote:

Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

Where do you want the warning?

What do you mean by "Splitting to next cell in row"? (You are only showing a
single column in your splits), at least that's what it looks like here.

What do you want to do with the part of the "split" fragment that is greater
than Max splitting length?
--ron

Ron Rosenfeld
Splitting text in cells.
 
On Sat, 12 Jan 2008 12:30:39 +0100, "Joergen Bondesen"
wrote:

Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

Perhaps this will give you some ideas.

I'm still not sure exactly what you want, but the Macro below will operate on
"Selection".

It will split the sentence into lines of MaxLength, breaking ONLY at <spaces
(and not at hyphens as per your example).

It places the fragments into rows underneath Selection.
If a "word" is greater than 22 characters, it places the remaining characters
in the "next cell in row" or adjacent column (with asterisks before and after),
and also puts a warning, by way of a comment, into the cell with the beginning
of the fragment.

========================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{0," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
If c.Count < 1 Then Exit Sub
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True
Set mc = re.Execute(c.Value)

c.Resize(mc.Count + 1, 2).Offset(1, 0).Clear
i = 1
For Each m In mc
With c
.Offset(i, 0).Value = Left(m.submatches(0), MaxLength)
If Len(m.submatches(0)) 22 Then
.Offset(i, 0).AddComment.Text "Warning: Splitting to next cell
in row"
.Offset(i, 0).Comment.Visible = False
.Offset(i, 1).Value = Mid(m.submatches(0), MaxLength + 1)
.Offset(i, 1).NumberFormat = "\*\*@\*\*"
End If
End With
i = i + 1
Next m
End Sub
==========================================
--ron

Ron Rosenfeld
Splitting text in cells.
 
On Sat, 12 Jan 2008 17:17:12 -0500, Ron Rosenfeld
wrote:

On Sat, 12 Jan 2008 12:30:39 +0100, "Joergen Bondesen"
wrote:

Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

Perhaps this will give you some ideas.

I'm still not sure exactly what you want, but the Macro below will operate on
"Selection".

It will split the sentence into lines of MaxLength, breaking ONLY at <spaces
(and not at hyphens as per your example).

It places the fragments into rows underneath Selection.
If a "word" is greater than 22 characters, it places the remaining characters
in the "next cell in row" or adjacent column (with asterisks before and after),
and also puts a warning, by way of a comment, into the cell with the beginning
of the fragment.

========================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{0," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
If c.Count < 1 Then Exit Sub
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True
Set mc = re.Execute(c.Value)

c.Resize(mc.Count + 1, 2).Offset(1, 0).Clear
i = 1
For Each m In mc
With c
.Offset(i, 0).Value = Left(m.submatches(0), MaxLength)
If Len(m.submatches(0)) 22 Then
.Offset(i, 0).AddComment.Text "Warning: Splitting to next cell
in row"
.Offset(i, 0).Comment.Visible = False
.Offset(i, 1).Value = Mid(m.submatches(0), MaxLength + 1)
.Offset(i, 1).NumberFormat = "\*\*@\*\*"
End If
End With
i = i + 1
Next m
End Sub
==========================================
--ron

Small correction in the regex above:

============================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{1," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
If c.Count < 1 Then Exit Sub
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True
Set mc = re.Execute(c.Value)

c.Resize(mc.Count + 1, 2).Offset(1, 0).Clear
i = 1
For Each m In mc
With c
.Offset(i, 0).Value = Left(m.submatches(0), MaxLength)
If Len(m.submatches(0)) 22 Then
.Offset(i, 0).AddComment.Text "Warning: Splitting to next cell
in row"
.Offset(i, 0).Comment.Visible = False
.Offset(i, 1).Value = Mid(m.submatches(0), MaxLength + 1)
.Offset(i, 1).NumberFormat = "\*\*@\*\*"
End If
End With
i = i + 1
Next m
End Sub
=========================================
--ron

Joergen Bondesen
Splitting text in cells.
 
Hi Ron.



Sorry about my bad explanation.

I have a column A, with customer information.

This information I have to print on a paper, but the width for this
information allows only 32 characters.



Therefore I must split column A info to column B, C ... ect. depending on
string length in Column A and maxlength for printing.



If "split" fragment that is greater than Max splitting length I want the
cell to be e.g. Red.



What to do with this fragment, I don't know, but I must go to the red cells
and have a look, and then take a decision or contact my customer for advice.



It is midtnight i Denmark now and I need my bed.

I'm looking forward to have a closer look at your macro in the morning.

--



Best regards from

Joergen Bondesen



"Ron Rosenfeld" skrev i en meddelelse
...
On Sat, 12 Jan 2008 12:30:39 +0100, "Joergen Bondesen"
wrote:

Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

Perhaps this will give you some ideas.

I'm still not sure exactly what you want, but the Macro below will operate
on
"Selection".

It will split the sentence into lines of MaxLength, breaking ONLY at
<spaces
(and not at hyphens as per your example).

It places the fragments into rows underneath Selection.
If a "word" is greater than 22 characters, it places the remaining
characters
in the "next cell in row" or adjacent column (with asterisks before and
after),
and also puts a warning, by way of a comment, into the cell with the
beginning
of the fragment.

========================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{0," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
If c.Count < 1 Then Exit Sub
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True
Set mc = re.Execute(c.Value)

c.Resize(mc.Count + 1, 2).Offset(1, 0).Clear
i = 1
For Each m In mc
With c
.Offset(i, 0).Value = Left(m.submatches(0), MaxLength)
If Len(m.submatches(0)) 22 Then
.Offset(i, 0).AddComment.Text "Warning: Splitting to next
cell
in row"
.Offset(i, 0).Comment.Visible = False
.Offset(i, 1).Value = Mid(m.submatches(0), MaxLength + 1)
.Offset(i, 1).NumberFormat = "\*\*@\*\*"
End If
End With
i = i + 1
Next m
End Sub
==========================================
--ron



Rick Rothstein \(MVP - VB\)
Splitting text in cells.
 
See if this does what you want...

Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim FirstSplit As Boolean
Dim TempString As String
Const MaxLength As Long = 32
FirstSplit = True
For Each C In Selection
ColOff = 0
TempString = C.Value
If Len(TempString) MaxLength And FirstSplit Then
MsgBox "Split to next cell in row"
FirstSplit = False
End If
For X = 1 To Len(TempString) Step MaxLength
C.Offset(0, ColOff).Value = Mid(TempString, X, MaxLength)
ColOff = ColOff + 1
Next
Next
End Sub


Rick


"Joergen Bondesen" wrote in message
...
Hi Ron.



Sorry about my bad explanation.

I have a column A, with customer information.

This information I have to print on a paper, but the width for this
information allows only 32 characters.



Therefore I must split column A info to column B, C ... ect. depending on
string length in Column A and maxlength for printing.



If "split" fragment that is greater than Max splitting length I want the
cell to be e.g. Red.



What to do with this fragment, I don't know, but I must go to the red
cells and have a look, and then take a decision or contact my customer for
advice.



It is midtnight i Denmark now and I need my bed.

I'm looking forward to have a closer look at your macro in the morning.

--



Best regards from

Joergen Bondesen



"Ron Rosenfeld" skrev i en meddelelse
...
On Sat, 12 Jan 2008 12:30:39 +0100, "Joergen Bondesen"
wrote:

Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

Perhaps this will give you some ideas.

I'm still not sure exactly what you want, but the Macro below will
operate on
"Selection".

It will split the sentence into lines of MaxLength, breaking ONLY at
<spaces
(and not at hyphens as per your example).

It places the fragments into rows underneath Selection.
If a "word" is greater than 22 characters, it places the remaining
characters
in the "next cell in row" or adjacent column (with asterisks before and
after),
and also puts a warning, by way of a comment, into the cell with the
beginning
of the fragment.

========================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{0," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
If c.Count < 1 Then Exit Sub
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True
Set mc = re.Execute(c.Value)

c.Resize(mc.Count + 1, 2).Offset(1, 0).Clear
i = 1
For Each m In mc
With c
.Offset(i, 0).Value = Left(m.submatches(0), MaxLength)
If Len(m.submatches(0)) 22 Then
.Offset(i, 0).AddComment.Text "Warning: Splitting to next
cell
in row"
.Offset(i, 0).Comment.Visible = False
.Offset(i, 1).Value = Mid(m.submatches(0), MaxLength + 1)
.Offset(i, 1).NumberFormat = "\*\*@\*\*"
End If
End With
i = i + 1
Next m
End Sub
==========================================
--ron

Ron Rosenfeld
Splitting text in cells.
 
On Sat, 12 Jan 2008 23:44:17 +0100, "Joergen Bondesen"
wrote:

Hi Ron.



Sorry about my bad explanation.

I have a column A, with customer information.

This information I have to print on a paper, but the width for this
information allows only 32 characters.



Therefore I must split column A info to column B, C ... ect. depending on
string length in Column A and maxlength for printing.



If "split" fragment that is greater than Max splitting length I want the
cell to be e.g. Red.



What to do with this fragment, I don't know, but I must go to the red cells
and have a look, and then take a decision or contact my customer for advice.



It is midtnight i Denmark now and I need my bed.

I'm looking forward to have a closer look at your macro in the morning.


That's a bit more clear. Try the macro below instead -- it will split the
data into adjacent columns (same row) based on the constant MaxLength (at the
top of the macro). It will also flag any words that were too long to be split
(a word is defined as being space-delimited) by making the font red; adding
asterisks before and after; and also adding a comment which will give you the
length of that word).

====================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{1," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True

For Each c In Selection
'clear some area to the right
Range(c(1, 2), c(1, 10)).Clear
Set mc = re.Execute(c.Value)
i = 1
For Each m In mc
With c.Offset(0, i)
.Value = m.submatches(0)
If Len(.Value) 22 Then
.AddComment.Text "Warning: Length is " & Len(.Value) _
& " MaxLength of " & MaxLength
.Comment.Visible = False
.NumberFormat = "[Red]\*\*@\*\*"
End If
End With
i = i + 1
Next m
Next c
End Sub
====================================
--ron

Joergen Bondesen
Splitting text in cells.
 
Hi Bob.

Thanks for your contribution and I am sorry about my bad description.

--

Best Regards from
Joergen Bondesen


"Bob Phillips" skrev i en meddelelse
...

With ActiveCell

If Len(.Value) MaxSplitLength Then

MsgBox "Splitting to next cell in row"
.Offset(0, 1).Value = Right$(.Value, Len(.Value) -
MaxSplitLength)
.Value = Left$(.Value, MaxSplitLength)
End If
End With

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"Joergen Bondesen" wrote in message
...
Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

--

Best regards from
Joergen Bondesen

Joergen Bondesen
Splitting text in cells.
 
Hi Rick.

Thanks for your contribution.
Rons macro is what I want.

--

Best Regards from
Joergen Bondesen


"Rick Rothstein (MVP - VB)" skrev i en
meddelelse ...
See if this does what you want...

Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim FirstSplit As Boolean
Dim TempString As String
Const MaxLength As Long = 32
FirstSplit = True
For Each C In Selection
ColOff = 0
TempString = C.Value
If Len(TempString) MaxLength And FirstSplit Then
MsgBox "Split to next cell in row"
FirstSplit = False
End If
For X = 1 To Len(TempString) Step MaxLength
C.Offset(0, ColOff).Value = Mid(TempString, X, MaxLength)
ColOff = ColOff + 1
Next
Next
End Sub


Rick


"Joergen Bondesen" wrote in message
...
Hi Ron.



Sorry about my bad explanation.

I have a column A, with customer information.

This information I have to print on a paper, but the width for this
information allows only 32 characters.



Therefore I must split column A info to column B, C ... ect. depending on
string length in Column A and maxlength for printing.



If "split" fragment that is greater than Max splitting length I want the
cell to be e.g. Red.



What to do with this fragment, I don't know, but I must go to the red
cells and have a look, and then take a decision or contact my customer
for advice.



It is midtnight i Denmark now and I need my bed.

I'm looking forward to have a closer look at your macro in the morning.

--



Best regards from

Joergen Bondesen



"Ron Rosenfeld" skrev i en meddelelse
...
On Sat, 12 Jan 2008 12:30:39 +0100, "Joergen Bondesen"

wrote:

Hi NG

I need to split cells with text strings.
Max Splitting length is normally between 20 and 40.
If a words length is greater than 'Max Splitting length', then I want a
warning.
Splitting to next cell in row

example A
"This is a test for splitting a text to max length on 22."
1: This is a test for
2: splitting a text to
3: max length on 22.

example B
"attacks against small_medium_and_large-sized organizations."
1: attacks against
2: small_medium_and_large-sized ** and warning**
3: organizations.


Any suggestion / proposal are welcome.

Perhaps this will give you some ideas.

I'm still not sure exactly what you want, but the Macro below will
operate on
"Selection".

It will split the sentence into lines of MaxLength, breaking ONLY at
<spaces
(and not at hyphens as per your example).

It places the fragments into rows underneath Selection.
If a "word" is greater than 22 characters, it places the remaining
characters
in the "next cell in row" or adjacent column (with asterisks before and
after),
and also puts a warning, by way of a comment, into the cell with the
beginning
of the fragment.

========================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{0," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
If c.Count < 1 Then Exit Sub
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True
Set mc = re.Execute(c.Value)

c.Resize(mc.Count + 1, 2).Offset(1, 0).Clear
i = 1
For Each m In mc
With c
.Offset(i, 0).Value = Left(m.submatches(0), MaxLength)
If Len(m.submatches(0)) 22 Then
.Offset(i, 0).AddComment.Text "Warning: Splitting to next
cell
in row"
.Offset(i, 0).Comment.Visible = False
.Offset(i, 1).Value = Mid(m.submatches(0), MaxLength + 1)
.Offset(i, 1).NumberFormat = "\*\*@\*\*"
End If
End With
i = i + 1
Next m
End Sub
==========================================
--ron

Joergen Bondesen
Splitting text in cells.
 
Hi Ron.

Perfect, thanks.
I like particularly your add.Comment because I realize I can GOTO Comments.

I have modifyed your macro a little bit, so my colleague can use the macro.
Any improvement to my modifications are welcome.


Option Explicit


'----------------------------------------------------------
' Procedure : SplitSentence
' Date : 20080113
' Author : Ron Rosenfeld
' Modifyed by : Joergen Bondesen
' Purpose : Split sentence in whole words to MaxStrLen.
' Note : Select RRange, only One Column.
' Enter MaxStrLen.
' No of MaxStrLen = new columns to the right
' Sentence MaxStrLen = Red Font and a
' Comments with length information.
' Red Fonts = MsgBox
' Trimming strings.
'----------------------------------------------------------
'
Sub SplitSentence()
Dim C As Range
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

Dim ErrCell As Boolean
ErrCell = False

On Error Resume Next
Dim RRange As Range
Set RRange = Application.InputBox _
("Select Range (1 column) for wordsplit", _
"Sentence Split", Selection.Address(False, False), _
Type:=8)

If RRange.Columns.Count 1 Then End
If Err < 0 Then End

Dim MaxStrLen As Long
MaxStrLen = Application.InputBox _
(prompt:="Enter max. Sentence Split, thanks.", _
Title:="Number", Type:=2)

If MaxStrLen = 0 Then End
On Error GoTo 0

Dim maxoff As Long
maxoff = 0

'// Speed
Application.ScreenUpdating = False

Dim xlCalc As XlCalculation
xlCalc = Application.Calculation
Application.Calculation = xlCalculationManual
On Error GoTo CalcBack


sPat = "\b(\S[\s\S]{1," & MaxStrLen - 1 _
& "}|[\s\S]{" & MaxStrLen + 1 & _
",}?)(\s|$)"

Set C = Selection
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True


'// No of Columns to insert
For Each C In Selection

Set mc = re.Execute(C.Value)
i = 1

For Each m In mc
i = i + 1

'// No of Columns to insert
If maxoff = i - 1 Then
maxoff = maxoff
Else
maxoff = i - 1
End If
Next m
Next C


'// Insert Columns
Dim of As Long
For of = 1 To maxoff
Columns(RRange.Column + of).Insert Shift:=xlToRight
Next of


'// Split
For Each C In Selection

'// clear some area to the right
'Range(C(1, 2), C(1, 10)).Clear

Set mc = re.Execute(Trim(C.Value))
i = 1

For Each m In mc
With C.Offset(0, i)
'// *
.Value = Trim(m.submatches(0))
If Len(.Value) 22 Then
.AddComment.Text _
"Warning: Length is " & Len(.Value) _
& " MaxStrLen of " & MaxStrLen
.Comment.Visible = False
'.NumberFormat = "[Red]\*\*@\*\*"
.NumberFormat = "[Red]@"
ErrCell = True
End If
End With
i = i + 1
Next m
Next C

'// Fit Columns
Dim Celloff As Long
For Celloff = 1 To maxoff
Columns(RRange.Column + Celloff).EntireColumn.AutoFit
Next Celloff

'// Reset
Application.ScreenUpdating = True

'// Red cells
If ErrCell = True Then
MsgBox "Red cell(s).", vbCritical, "Warning."
End If

CalcBack:

Application.Calculation = xlCalc

'// Reset
Set RRange = Nothing
Set C = Nothing
Set re = Nothing
End Sub


--

Best Regards from
Joergen Bondesen


"Ron Rosenfeld" skrev i en meddelelse
...
On Sat, 12 Jan 2008 23:44:17 +0100, "Joergen Bondesen"
wrote:

Hi Ron.
Sorry about my bad explanation.
I have a column A, with customer information.
This information I have to print on a paper, but the width for this
information allows only 32 characters.
Therefore I must split column A info to column B, C ... ect. depending on
string length in Column A and maxlength for printing.
If "split" fragment that is greater than Max splitting length I want the
cell to be e.g. Red.
What to do with this fragment, I don't know, but I must go to the red
cells
and have a look, and then take a decision or contact my customer for
advice.
It is midtnight i Denmark now and I need my bed.
I'm looking forward to have a closer look at your macro in the morning.


That's a bit more clear. Try the macro below instead -- it will split
the
data into adjacent columns (same row) based on the constant MaxLength (at
the
top of the macro). It will also flag any words that were too long to be
split
(a word is defined as being space-delimited) by making the font red;
adding
asterisks before and after; and also adding a comment which will give you
the
length of that word).

====================================
Option Explicit
Sub SplitSentence()
Dim c As Range
Const MaxLength As Long = 22
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

sPat = "\b(\S[\s\S]{1," & MaxLength - 1 _
& "}|[\s\S]{" & MaxLength + 1 & _
",}?)(\s|$)"

Set c = Selection
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True

For Each c In Selection
'clear some area to the right
Range(c(1, 2), c(1, 10)).Clear
Set mc = re.Execute(c.Value)
i = 1
For Each m In mc
With c.Offset(0, i)
.Value = m.submatches(0)
If Len(.Value) 22 Then
.AddComment.Text "Warning: Length is " & Len(.Value) _
& " MaxLength of " & MaxLength
.Comment.Visible = False
.NumberFormat = "[Red]\*\*@\*\*"
End If
End With
i = i + 1
Next m
Next c
End Sub
====================================
--ron



Ron Rosenfeld
Splitting text in cells.
 
On Sun, 13 Jan 2008 12:25:21 +0100, "Joergen Bondesen"
wrote:

Hi Ron.

Perfect, thanks.
I like particularly your add.Comment because I realize I can GOTO Comments.

I have modifyed your macro a little bit, so my colleague can use the macro.
Any improvement to my modifications are welcome.

I was glad to be able to help. Thank you for the feedback.
--ron

Ron Rosenfeld
Splitting text in cells.
 
On Sun, 13 Jan 2008 12:25:21 +0100, "Joergen Bondesen"
wrote:

Hi Ron.

Perfect, thanks.
I like particularly your add.Comment because I realize I can GOTO Comments.

I have modifyed your macro a little bit, so my colleague can use the macro.
Any improvement to my modifications are welcome.


Option Explicit


'----------------------------------------------------------
' Procedure : SplitSentence
' Date : 20080113
' Author : Ron Rosenfeld
' Modifyed by : Joergen Bondesen
' Purpose : Split sentence in whole words to MaxStrLen.
' Note : Select RRange, only One Column.
' Enter MaxStrLen.
' No of MaxStrLen = new columns to the right
' Sentence MaxStrLen = Red Font and a
' Comments with length information.
' Red Fonts = MsgBox
' Trimming strings.
'----------------------------------------------------------
'
Sub SplitSentence()
Dim C As Range
Dim re As Object, mc As Object, m As Object
Dim sPat As String
Dim i As Long

Dim ErrCell As Boolean
ErrCell = False

On Error Resume Next
Dim RRange As Range
Set RRange = Application.InputBox _
("Select Range (1 column) for wordsplit", _
"Sentence Split", Selection.Address(False, False), _
Type:=8)

If RRange.Columns.Count 1 Then End
If Err < 0 Then End

Dim MaxStrLen As Long
MaxStrLen = Application.InputBox _
(prompt:="Enter max. Sentence Split, thanks.", _
Title:="Number", Type:=2)

If MaxStrLen = 0 Then End
On Error GoTo 0

Dim maxoff As Long
maxoff = 0

'// Speed
Application.ScreenUpdating = False

Dim xlCalc As XlCalculation
xlCalc = Application.Calculation
Application.Calculation = xlCalculationManual
On Error GoTo CalcBack


sPat = "\b(\S[\s\S]{1," & MaxStrLen - 1 _
& "}|[\s\S]{" & MaxStrLen + 1 & _
",}?)(\s|$)"

Set C = Selection
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
re.MultiLine = True


'// No of Columns to insert
For Each C In Selection

Set mc = re.Execute(C.Value)
i = 1

For Each m In mc
i = i + 1

'// No of Columns to insert
If maxoff = i - 1 Then
maxoff = maxoff
Else
maxoff = i - 1
End If
Next m
Next C


'// Insert Columns
Dim of As Long
For of = 1 To maxoff
Columns(RRange.Column + of).Insert Shift:=xlToRight
Next of


'// Split
For Each C In Selection

'// clear some area to the right
'Range(C(1, 2), C(1, 10)).Clear

Set mc = re.Execute(Trim(C.Value))
i = 1

For Each m In mc
With C.Offset(0, i)
'// *
.Value = Trim(m.submatches(0))
If Len(.Value) 22 Then
.AddComment.Text _
"Warning: Length is " & Len(.Value) _
& " MaxStrLen of " & MaxStrLen
.Comment.Visible = False
'.NumberFormat = "[Red]\*\*@\*\*"
.NumberFormat = "[Red]@"
ErrCell = True
End If
End With
i = i + 1
Next m
Next C

'// Fit Columns
Dim Celloff As Long
For Celloff = 1 To maxoff
Columns(RRange.Column + Celloff).EntireColumn.AutoFit
Next Celloff

'// Reset
Application.ScreenUpdating = True

'// Red cells
If ErrCell = True Then
MsgBox "Red cell(s).", vbCritical, "Warning."
End If

CalcBack:

Application.Calculation = xlCalc

'// Reset
Set RRange = Nothing
Set C = Nothing
Set re = Nothing
End Sub


Two issues occur to me.

1. There should be no need for the Trim function -- this can be handled by a
minor change in the Regex.

2. As written, the regex assumes that your "words" will start only with a
letter, digit, or underscore. Other characters may be ignored if they are at
the start of a split.

The following modification handles both of these issues:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength + 1 _
& ",}?\S))(\s|$)"


--ron

Ron Rosenfeld
Splitting text in cells.
 
On Sun, 13 Jan 2008 23:58:31 -0500, Ron Rosenfeld
wrote:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength + 1 _
& ",}?\S))(\s|$)"


TYPO ALERT! SHOULD READ:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"
--ron

Ron Rosenfeld
Splitting text in cells.
 
On Mon, 14 Jan 2008 00:22:22 -0500, Ron Rosenfeld
wrote:

On Sun, 13 Jan 2008 23:58:31 -0500, Ron Rosenfeld
wrote:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength + 1 _
& ",}?\S))(\s|$)"


TYPO ALERT! SHOULD READ:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"
--ron

One further edit:

sPat = "((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"

--ron

Rick Rothstein \(MVP - VB\)
Splitting text in cells.
 
sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength + 1 _
& ",}?\S))(\s|$)"


TYPO ALERT! SHOULD READ:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"
--ron

One further edit:

sPat = "((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"

You just have to love regular expressions for their clarity and ease of
use.<vbg

(Sorry, couldn't resist.)

Rick


Rick Rothstein \(MVP - VB\)
Splitting text in cells.
 
After looking at Ron's subroutine, I realized that the output from mine is
not what most people would want (I simple broke the lines apart even if the
meant breaking a word into two parts). Here is the routine modified to keep
all words whole....

Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
FirstSplit = True
For Each C In Selection
ColOff = 1
Words() = Split(C.Value, " ")
If Len(C.Value) MaxLength And FirstSplit Then
MsgBox "Split to next cell in row"
FirstSplit = False
End If
CumulativeLength = 0
For X = 0 To UBound(Words)
If X = UBound(Words) Then
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
Next
End Sub


Rick


Ron Rosenfeld
Splitting text in cells.
 
On Mon, 14 Jan 2008 01:28:03 -0500, "Rick Rothstein \(MVP - VB\)"
wrote:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength + 1 _
& ",}?\S))(\s|$)"


TYPO ALERT! SHOULD READ:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"
--ron

One further edit:

sPat = "((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"

You just have to love regular expressions for their clarity and ease of
use.<vbg

(Sorry, couldn't resist.)

Rick

I don't blame you. But once I got used to working in the syntax, I find this
kind of string manipulation easier to do using regular expressions than doing
the same process with just the native VBA tools.
--ron

Joergen Bondesen
Splitting text in cells.
 
Hi Rick

I'm very glad for your new macro.

It gives me opportunities to learn VBA. (No bad feelings about regexp, 8-))



I do hope you will comment my modification, because I'm not so experienced
with VBA.



Option Explicit

'// Modifyed by Joergen Bondesen, 20080115
Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
' Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
' FirstSplit = True

For Each C In Selection
ColOff = 1

Words() = Split(C.Value, " ")
'// jb Not necessary
' If Len(C.Value) MaxLength And FirstSplit Then
' MsgBox "Split to next cell in row"
' FirstSplit = False
' End If

CumulativeLength = 0

For X = 0 To UBound(Words)
If X = UBound(Words) Then
'// jb If X=UBound(Words)
If CumulativeLength + Len(Words(X)) MaxLength And _
CumulativeText = vbNullString Then
'// only 1 long word
C.Offset(0, ColOff).Value = Trim(Words(X))
MsgBox "Err" & C.Address
ElseIf CumulativeLength + Len(Words(X)) MaxLength _
And CumulativeText < vbNullString Then
'// Only 2 words and together MaxLength
C.Offset(0, ColOff).Value = Trim(CumulativeText)
C.Offset(0, ColOff + 1).Value = Trim(Words(X))
Else
'// <= MaxLength
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
End If

Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
'// jb, Avoid accumulate
CumulativeText = vbNullString
Next
End Sub

--

Best Regards from
Joergen Bondesen



"Rick Rothstein (MVP - VB)" skrev i en
meddelelse ...
After looking at Ron's subroutine, I realized that the output from mine is
not what most people would want (I simple broke the lines apart even if
the meant breaking a word into two parts). Here is the routine modified to
keep all words whole....

Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
FirstSplit = True
For Each C In Selection
ColOff = 1
Words() = Split(C.Value, " ")
If Len(C.Value) MaxLength And FirstSplit Then
MsgBox "Split to next cell in row"
FirstSplit = False
End If
CumulativeLength = 0
For X = 0 To UBound(Words)
If X = UBound(Words) Then
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
Next
End Sub


Rick



Joergen Bondesen
Splitting text in cells.
 
Hi Ron.

Thanks.
I have compleate confidence to you. 8-)

--

Best Regards from
Joergen Bondesen


"Ron Rosenfeld" skrev i en meddelelse
...
On Mon, 14 Jan 2008 00:22:22 -0500, Ron Rosenfeld

wrote:

On Sun, 13 Jan 2008 23:58:31 -0500, Ron Rosenfeld

wrote:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength + 1 _
& ",}?\S))(\s|$)"


TYPO ALERT! SHOULD READ:

sPat = "\s?((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"
--ron

One further edit:

sPat = "((\S[\s\S]{1," & MaxLength - 2 _
& "}\S)|(\S[\s\S]{" & MaxLength - 1 _
& ",}?\S))(\s|$)"

--ron



Rick Rothstein \(MVP - VB\)
Splitting text in cells.
 
Yes, your modifications are fine. I'm not sure what I was thinking of at the
time, but there is no re-entrant problems associated with the code so no
protection against re-entry is required.

Rick


"Joergen Bondesen" wrote in message
...
Hi Rick

I'm very glad for your new macro.

It gives me opportunities to learn VBA. (No bad feelings about regexp,
8-))



I do hope you will comment my modification, because I'm not so experienced
with VBA.



Option Explicit

'// Modifyed by Joergen Bondesen, 20080115
Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
' Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
' FirstSplit = True

For Each C In Selection
ColOff = 1

Words() = Split(C.Value, " ")
'// jb Not necessary
' If Len(C.Value) MaxLength And FirstSplit Then
' MsgBox "Split to next cell in row"
' FirstSplit = False
' End If

CumulativeLength = 0

For X = 0 To UBound(Words)
If X = UBound(Words) Then
'// jb If X=UBound(Words)
If CumulativeLength + Len(Words(X)) MaxLength And _
CumulativeText = vbNullString Then
'// only 1 long word
C.Offset(0, ColOff).Value = Trim(Words(X))
MsgBox "Err" & C.Address
ElseIf CumulativeLength + Len(Words(X)) MaxLength _
And CumulativeText < vbNullString Then
'// Only 2 words and together MaxLength
C.Offset(0, ColOff).Value = Trim(CumulativeText)
C.Offset(0, ColOff + 1).Value = Trim(Words(X))
Else
'// <= MaxLength
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
End If

Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
'// jb, Avoid accumulate
CumulativeText = vbNullString
Next
End Sub

--

Best Regards from
Joergen Bondesen



"Rick Rothstein (MVP - VB)" skrev i en
meddelelse ...
After looking at Ron's subroutine, I realized that the output from mine
is not what most people would want (I simple broke the lines apart even
if the meant breaking a word into two parts). Here is the routine
modified to keep all words whole....

Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
FirstSplit = True
For Each C In Selection
ColOff = 1
Words() = Split(C.Value, " ")
If Len(C.Value) MaxLength And FirstSplit Then
MsgBox "Split to next cell in row"
FirstSplit = False
End If
CumulativeLength = 0
For X = 0 To UBound(Words)
If X = UBound(Words) Then
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
Next
End Sub


Rick

Joergen Bondesen
Splitting text in cells.
 
Hi Rick

Thanks.

--

Best Regards from
Joergen Bondesen


"Rick Rothstein (MVP - VB)" skrev i en
meddelelse ...
Yes, your modifications are fine. I'm not sure what I was thinking of at
the time, but there is no re-entrant problems associated with the code so
no protection against re-entry is required.

Rick


"Joergen Bondesen" wrote in message
...
Hi Rick

I'm very glad for your new macro.

It gives me opportunities to learn VBA. (No bad feelings about regexp,
8-))



I do hope you will comment my modification, because I'm not so
experienced with VBA.



Option Explicit

'// Modifyed by Joergen Bondesen, 20080115
Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
' Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
' FirstSplit = True

For Each C In Selection
ColOff = 1

Words() = Split(C.Value, " ")
'// jb Not necessary
' If Len(C.Value) MaxLength And FirstSplit Then
' MsgBox "Split to next cell in row"
' FirstSplit = False
' End If

CumulativeLength = 0

For X = 0 To UBound(Words)
If X = UBound(Words) Then
'// jb If X=UBound(Words)
If CumulativeLength + Len(Words(X)) MaxLength And _
CumulativeText = vbNullString Then
'// only 1 long word
C.Offset(0, ColOff).Value = Trim(Words(X))
MsgBox "Err" & C.Address
ElseIf CumulativeLength + Len(Words(X)) MaxLength _
And CumulativeText < vbNullString Then
'// Only 2 words and together MaxLength
C.Offset(0, ColOff).Value = Trim(CumulativeText)
C.Offset(0, ColOff + 1).Value = Trim(Words(X))
Else
'// <= MaxLength
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
End If

Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
'// jb, Avoid accumulate
CumulativeText = vbNullString
Next
End Sub

--

Best Regards from
Joergen Bondesen



"Rick Rothstein (MVP - VB)" skrev i en
meddelelse ...
After looking at Ron's subroutine, I realized that the output from mine
is not what most people would want (I simple broke the lines apart even
if the meant breaking a word into two parts). Here is the routine
modified to keep all words whole....

Sub SplitIntoLines()
Dim C As Range
Dim X As Long
Dim ColOff As Long
Dim CumulativeLength As Long
Dim FirstSplit As Boolean
Dim CumulativeText As String
Dim Words() As String
Const MaxLength As Long = 32
FirstSplit = True
For Each C In Selection
ColOff = 1
Words() = Split(C.Value, " ")
If Len(C.Value) MaxLength And FirstSplit Then
MsgBox "Split to next cell in row"
FirstSplit = False
End If
CumulativeLength = 0
For X = 0 To UBound(Words)
If X = UBound(Words) Then
C.Offset(0, ColOff).Value = CumulativeText & Words(X)
Exit For
ElseIf RTrim(CumulativeLength + Len(Words(X))) MaxLength Then
C.Offset(0, ColOff).Value = RTrim(CumulativeText)
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
ElseIf Len(CumulativeText) = MaxLength Then
C.Offset(0, ColOff).Value = CumulativeText
ColOff = ColOff + 1
CumulativeText = Words(X) & " "
CumulativeLength = Len(Words(X)) + 1
Else
CumulativeText = CumulativeText & Words(X) & " "
CumulativeLength = CumulativeLength + Len(Words(X)) + 1
End If
Next
Next
End Sub


Rick


All times are GMT +1. The time now is 09:18 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com