separate text into two columns

  • Thread starter Thread starter gwbdirect
  • Start date Start date
Fantastic. Sorry I must have tried Rick's first. This macro works perfectly.
Thanks for all your help!!!!
Click to expand...


Oh good. Glad to help. Thanks for the feedback.

I have an improvement to the pattern which you should use for best results.

Please change this line:

re.Pattern = "\s?((\S[\s\S]{1," & W - 2 & _
"}\S)|(\S[\s\S]{" & W - 1 & ",}?\S))(\s|$)"

to this:

re.Pattern = "\b\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"


By the way, note that you can change the default value in the InputBox
statement, or even hard code it to the variable and omit having to even see the
InputBox.

Also, note (and this is documented), that if you have a single word that is
longer than desired length, it will not wrap or be truncated. For example, if
you had a maximum line length of 7, and had a word like "totalitarianism", the
word would not wrap, but would be on a line by itself.
--ron
 
re.Pattern = "\b\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"
Click to expand...

That should really be changed to:

re.Pattern = "\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"
--ron
 
Hi Ron,
Thanks again for all your help. The code works great. I did try the new code:

re.Pattern = "\b\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"

got a debug error on line:

C.Offset(0, i).Value = m.SubMatches(0)





Ron Rosenfeld said:
Fantastic. Sorry I must have tried Rick's first. This macro works perfectly.
Thanks for all your help!!!!
Click to expand...


Oh good. Glad to help. Thanks for the feedback.

I have an improvement to the pattern which you should use for best results.

Please change this line:

re.Pattern = "\s?((\S[\s\S]{1," & W - 2 & _
"}\S)|(\S[\s\S]{" & W - 1 & ",}?\S))(\s|$)"

to this:

re.Pattern = "\b\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"


By the way, note that you can change the default value in the InputBox
statement, or even hard code it to the variable and omit having to even see the
InputBox.

Also, note (and this is documented), that if you have a single word that is
longer than desired length, it will not wrap or be truncated. For example, if
you had a maximum line length of 7, and had a word like "totalitarianism", the
word would not wrap, but would be on a line by itself.
--ron
Click to expand...
 
Hi Ron,
Thanks again for all your help. The code works great. I did try the new code:

re.Pattern = "\b\S.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"

got a debug error on line:

C.Offset(0, i).Value = m.SubMatches(0)
Click to expand...

I'm sorry about that. With this better 'pattern' I forgot to tell you that
line needs to be changed also:

C.Offset(0, i).Value = m


Here is a full copy that should work:

================================
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 beside 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.{0," & W - 1 & "}(?=\s|$)|\S{" & W & ",}"
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
i = i + 1
Next m
End If
Next c
Set re = Nothing
End Sub
=======================================
--ron
 
Back
Top