split string-paragraph to cells of 30 character lengths without splitting words

[blicop]

I need help to split strings/paragraphs to cells of 30 character lengths without splitting words. Any help would be highly appreciated

Original	30 len split
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Etiam ac viverra dolor, nec facilisis metus. Maecenas nisl augue, vestibulum quis vestibulum sed, accumsan eget lectus. Nunc urna nunc, lobortis eget.	Lorem ipsum dolor sit amet,
	consectetur adipiscing elit. <tbody> </tbody>
	Etiam ac viverra dolor, nec <tbody> </tbody>
	facilisis metus. Maecenas <tbody> </tbody>
	nisl augue, vestibulum quis <tbody> </tbody>
	vestibulum quis vestibulum sed <tbody> </tbody>
	, accumsan eget lectus. Nunc <tbody> </tbody>
	urna nunc, lobortis eget. <tbody> </tbody>

<tbody>
</tbody>

 

[MickG]

Try this for Results in column "B".

[COLOR="Navy"]Sub[/COLOR] MG08Feb05
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Str [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
Sp = Split(Dn.Value, " ")
c = 0
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Sp
    c = c + Len(R)
        [COLOR="Navy"]If[/COLOR] c > 30 [COLOR="Navy"]Then[/COLOR]
            c = Len(R)
            Rw = Rw + 1
            Cells(Rw, 2) = Str: Str = ""
        [COLOR="Navy"]End[/COLOR] If
            Str = Str & " " & R
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[blicop]

did a test and theres an issue. see below (last column is character length passing 30 and last line missing "

urna nunc, lobortis eget."

<tbody>
</tbody>

Lorem ipsum dolor sit amet, consectetur adipiscing elit. Etiam ac viverra dolor, nec facilisis metus. Maecenas nisl augue, vestibulum quis vestibulum sed, accumsan eget lectus. Nunc urna nunc, lobortis eget.	Lorem ipsum dolor sit amet,	28
	consectetur adipiscing elit.	29
	Etiam ac viverra dolor, nec	28
	facilisis metus. Maecenas nisl	31
	augue, vestibulum quis vestibulum	34
	sed, accumsan eget lectus. Nunc	32

<colgroup><col><col><col></colgroup><tbody>
</tbody>

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub WrapSplitText()
  Dim Space As Long, Text As String, TextMax As String, WrapText As String, SplitText() As String
  Const MaxChars As Long = 30
  Text = Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))))
  Do While Len(Text) > MaxChars
    TextMax = Left(Text, MaxChars + 1)
    If Right(TextMax, 1) = " " Then
      WrapText = WrapText & RTrim(TextMax) & vbLf
      Text = Mid(Text, MaxChars + 2)
    Else
      Space = InStrRev(TextMax, " ")
      If Space = 0 Then
        WrapText = WrapText & Left(Text, MaxChars) & vbLf
        Text = Mid(Text, MaxChars + 1)
      Else
        WrapText = WrapText & Left(TextMax, Space - 1) & vbLf
        Text = Mid(Text, Space + 1)
      End If
    End If
  Loop
  SplitText = Split(WrapText & Text, vbLf)
  Range("B1").Resize(UBound(SplitText) + 1) = Application.Transpose(SplitText)
End Sub[/td]
[/tr]
[/table]

 

[blicop]

runtime error 13
type mismatch

 

[Rick Rothstein]

runtime error 13
type mismatch

Hmm, the code I posted works fine for me...

1) What line of code does the debugger stop at (highlight) when that error occurs?

2) Where is your data located at (I assumed the active sheet in Column A starting on Row 1)?

3) What version of Excel are you using.

 

[blicop]

1. Stops after " Text = Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))))"

2. Data is in A1 (Active Sheet)

3. Excel 2016

 

[Rick Rothstein]

1. Stops after " Text = Join(Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp))))"

2. Data is in A1 (Active Sheet)

3. Excel 2016

Ah, you only have a single cell with data... I took my cue from MickG's code and assumed you had multiple cells that you wanted to join together and then distribute at 30 characters per cell. This modified code provides for both possibilities (a single cell with data or multiple cells with data)...

[table="width: 500"]
[tr]
	[td]Sub WrapSplitText()
  Dim Space As Long, Text As Variant, TextMax As String, WrapText As String, SplitText() As String
  Const MaxChars As Long = 30
  Text = Application.Transpose(Range("A1", Cells(Rows.Count, "A").End(xlUp)))
  If IsArray(Text) Then Text = Join(Text)
  Do While Len(Text) > MaxChars
    TextMax = Left(Text, MaxChars + 1)
    If Right(TextMax, 1) = " " Then
      WrapText = WrapText & RTrim(TextMax) & vbLf
      Text = Mid(Text, MaxChars + 2)
    Else
      Space = InStrRev(TextMax, " ")
      If Space = 0 Then
        WrapText = WrapText & Left(Text, MaxChars) & vbLf
        Text = Mid(Text, MaxChars + 1)
      Else
        WrapText = WrapText & Left(TextMax, Space - 1) & vbLf
        Text = Mid(Text, Space + 1)
      End If
    End If
  Loop
  SplitText = Split(WrapText & Text, vbLf)
  Range("B1").Resize(UBound(SplitText) + 1) = Application.Transpose(SplitText)
End Sub[/td]
[/tr]
[/table]