Hi Rick

Thanks.

--

Best Regards from
Joergen Bondesen


"Rick Rothstein (MVP - VB)" skrev i en
meddelelse ...
Yes, your modifications are fine. I'm not sure what I was thinking of at
the time, but there is no re-entrant problems associated with the code so
no protection against re-entry is required.

Rick


"Joergen Bondesen" wrote in message
...
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