I would like to separate a text field (company name) into two columns
whenever it is longer than 25 characters but I want it to separate after a
space and not break in the middle of a name like the example below:
co name 1
company name 2
A & M Construction A & M Construct ion
A Better Chance, Inc. A Better Chanc e,
Inc.
Would like it to come out like the example below:
A & M Construction A & M
Construction
A Better Chance, Inc. A Better Chance, Inc.
=left(a2,10) doesn't work. Is there another formula that will
Neither of your company names are longer than 25 characters, so I don't really
understand how you are separating them.
But here is a macro that will split at any length you wish. (Using 16 seems to
obtain the results you show above).
To enter this, <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.
To use it, select the cells to be split. Then <alt-F8> opens the macro dialog
box. Select the macro and <RUN>.
As written, it splits into the adjacent columns. The macro can be edited to
"replace" the first column contents by changing the value for lDestOffset from
1 to 0.
================================
Option Explicit
Sub WordWrap16()
'Wraps at W characters, but will allow overflow if a word is longer than W
Dim re As Object, mc As Object, m As Object
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.Columns.Count <> 1 Then
MsgBox ("You may only select" & vbLf & " Data in One (1) Column")
Exit Sub
End If
Set re = CreateObject("vbscript.regexp")
re.Global = True
W = InputBox("Maximum characters in a Line: ", , 16)
If W < 1 Then W = 16
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(1, i)) <> 0 Then
mBox = _
MsgBox("Data in " & c(1, i).Address & _
" will be erased if you continue", vbOKCancel)
If mBox = vbCancel Then Exit Sub
End If
i = i + 1
Loop
i = lDestOffset
For Each m In mc
c.Offset(0, i).Value = m.SubMatches(0)
i = i + 1
Next m
End If
Next c
Set re = Nothing
End Sub
=================================
--ron
)