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

B

blicop

New Member
Joined
Aug 9, 2011
Messages
18
Office Version
  1. 365
Platform
  1. Windows
I need help to split strings/paragraphs to cells of 30 character lengths without splitting words. Any help would be highly appreciated

[TABLE="width: 500"]
<tbody>[TR]
[TD]Original[/TD]
[TD]30 len split[/TD]
[/TR]
[TR]
[TD]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.[/TD]
[TD]Lorem ipsum dolor sit amet,[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"]consectetur adipiscing elit.[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"]Etiam ac viverra dolor, nec[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"]facilisis metus. Maecenas[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"]nisl augue, vestibulum quis[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"]vestibulum quis vestibulum sed[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"], accumsan eget lectus. Nunc[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][TABLE="width: 209"]
<tbody>[TR]
[TD="width: 209"]urna nunc, lobortis eget.[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Try this for Results in column "B".
Code: 
[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
 
Upvote 0
did a test and theres an issue. see below (last column is character length passing 30 and last line missing "[TABLE="class: cms_table, width: 209"]
<tbody>[TR]
[TD="width: 209"]urna nunc, lobortis eget."

[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="width: 360"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]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.[/TD]
[TD] Lorem ipsum dolor sit amet,[/TD]
[TD="align: right"]28[/TD]
[/TR]
[TR]
[TD][/TD]
[TD] consectetur adipiscing elit.[/TD]
[TD="align: right"]29[/TD]
[/TR]
[TR]
[TD][/TD]
[TD] Etiam ac viverra dolor, nec[/TD]
[TD="align: right"]28[/TD]
[/TR]
[TR]
[TD][/TD]
[TD] facilisis metus. Maecenas nisl[/TD]
[TD="align: right"]31[/TD]
[/TR]
[TR]
[TD][/TD]
[TD] augue, vestibulum quis vestibulum[/TD]
[TD="align: right"]34[/TD]
[/TR]
[TR]
[TD][/TD]
[TD] sed, accumsan eget lectus. Nunc[/TD]
[TD="align: right"]32[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Give this macro a try...
Code: 
[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]
 
Last edited:
Upvote 0
blicop said:
runtime error 13
type mismatch
Click to expand...
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.
 
Upvote 0
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
 
Upvote 0
blicop said:
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
Click to expand...
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)...
Code: 
[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]
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Fixing the macro for text splitting (rows being skipped)
Replies
6
Views
443
Georgiboy
Georgiboy
B
  • Solved
Pull names that left messages
Replies
3
Views
258
Fluff
Fluff
B
  • Question Question
XML to PDF
Replies
0
Views
273
BijanBorazjani
B
M
  • Solved
Help with separating Text String from a Excel Col
Replies
3
Views
589
Peter_SSs
Peter_SSs
R
  • Question Question
How to find a range of words in a list of row?
Replies
8
Views
808
Eric W
Eric W

Forum statistics

Threads
1,223,099
Messages
6,170,108
Members
452,302
Latest member
TaMere

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top