View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default 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