I really need help on "How to split wrapped text in a single cell into
multiple lines" e.g
Text (wrapped) appear in one cell
Prepare and allow "Rentokil" anti termite treatment as described to sides
and bottom of foundation pit and basement beams trenches and all top surfaces
of lean concrete to basement floor area including apron and verandah.
Provide 5 years warranty.
A little better description of your data and requirements would be useful.
For example. Is the text actually "wrapped" with no included linefeeds or
carriage returns?
Will you always want the last sentence on its own line?
For example, if the wrapped text is really caused by embedded CR/LF, then you
can select the text in the formula bar; COPY it; SELECT your target cell; PASTE
and the lines will go into individual rows.
Or it can be done with a VBA macro, but if you require the last sentence in its
own cell, the routine will be different.
Here is a Macro that will split the contents of cells into the rows below. As
written it will place the split data into the rows below. Read the comments to
see how to change it to replace the original data with the first line.
If you want to have the last sentence treated separately, you will need more
code.
Note that the routine requires that you set a reference (see Tools/References
from the VBA Menu Bar) to Microsoft VBScript Regular Expressions 5.5
To enter this macro, <alt-F11> opens the VBEditor. Ensure your project is
highlighted in the project explorer window, then Insert/Module and paste the
code below into the window that opens.
Then set the reference (Tools/References) as mentioned above.
To use this, <alt-F8> opens the macro dialog box. Select "ww" and <RUN>.
Select one or more cells in the same row to be split. Enter your preferred
line length.
The split will be at spaces between words.
===================================================
Option Explicit
Sub ww()
'requires reference to Microsoft VBScript Regular Expressions 5.5
'Wraps at W characters, but will allow overflow if a line is longer than W
Dim re As RegExp, mc As MatchCollection, m As Match
Dim Str As String
Dim W As Long
Dim rSrc As Range, c As Range
Dim mBox As Long
Dim i As Long
'with offset as 1, split data will be below original data
'with offset = 0, split data will replace original data
Const lDestOffset As Long = 1
Set rSrc = Selection
If rSrc.Rows.Count <> 1 Then
MsgBox ("You may only select" & vbLf & " Data in One (1) Row")
Exit Sub
End If
Set re = New RegExp
re.Global = True
W = InputBox("Maximum characters in a Line: ", , 79)
If W < 1 Then W = 79
For Each c In rSrc
Str = c.Value
'remove all line feeds and nbsp
re.Pattern = "[\xA0\r\n]"
Str = re.Replace(Str, " ")
re.Pattern = "\s?((\S[\s\S]{1," & W - 2 & "}\S)|(\S[\s\S]{" _
& W - 1 & ",}?\S))(\s|$)"
If re.Test(Str) = True Then
Set mc = re.Execute(Str)
'see if there is enough room
i = lDestOffset + 1
Do Until i > mc.Count + lDestOffset
If Len(c(i, 1)) <> 0 Then
mBox = MsgBox("Data in " & c(i, 1).Address & " will be erased if you
contine", vbOKCancel)
If mBox = vbCancel Then Exit Sub
End If
i = i + 1
Loop
i = lDestOffset
For Each m In mc
c.Offset(i, 0).Value = m.SubMatches(0)
i = i + 1
Next m
End If
Next c
Set re = Nothing
End Sub
==================================
--ron
