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

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

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

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

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

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

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

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

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

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

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

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

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

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

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