View Single Post
  #1   Report Post  
JMB
 
Posts: n/a
Default Text Wrapping

If you want to try to split the text among multiple cells, you could try the
following macro. I use it when I write paragraphs of text that go beyond the
right margin of the page. It only works on one column at a time, but can do
multiple rows. Widen your column to set where you want the text wrapped
(column width dictates where the text is split), select the cell(s) you want
wrapped, run the macro, then change your column width back to where it was
originally.

I know there is a better/easier/more efficient way to write this, but I
wrote the macro back when I was just learning VBA and never went back to
streamline it.

Be sure to back up your data.


Sub text_wrap()

Dim ColWidth As Single
Dim SelectionAddress As Variant
Dim Rw As Integer
Dim SplitTextString As Variant
Dim Count1 As Integer
Dim Count2 As Integer
Dim StartRange As Variant
Dim TextString As String

ColWidth = Selection.ColumnWidth
Rw = Selection.Rows.Count
StartRange = ActiveCell.Address
SelectionAddress = Selection.Address

For Each x In Range(SelectionAddress)
If x.Value = "" Then TextString = TextString & "_"
TextString = TextString & x.Value & " "
x.Value = ""
Next x

SplitTextString = Split(TextString, " ", -1, vbTextCompare)

Range(StartRange).Select
Selection.EntireColumn.Insert
Selection.ColumnWidth = ColWidth
Count1 = 0
Count2 = 1

Do While Count1 <= UBound(SplitTextString) - 1
Do While Selection.ColumnWidth <= ColWidth And Count1 <=
UBound(SplitTextString) - 1
Do While SplitTextString(Count1) = "_"
If Len(Selection.Value) 0 Then
ActiveCell.Offset(0, 1).Value = Selection.Value
ActiveCell.Offset(1, 0).Select
Count2 = Count2 + 1
If Count2 Rw Then Selection.EntireRow.Insert
End If
ActiveCell.Offset(1, 0).Select
Count2 = Count2 + 1
If Count2 Rw And Count1 < UBound(SplitTextString) - 1 _
Then Selection.EntireRow.Insert
Count1 = Count1 + 1
Loop
If Count1 < UBound(SplitTextString) Then
Selection.Value = Selection.Value & SplitTextString(Count1) & " "
Selection.EntireColumn.AutoFit
Count1 = Count1 + 1
End If
Loop
If Count1 <= UBound(SplitTextString) And Len(Selection.Value) 0 Then
Selection.Value = Left(Selection.Value, Len(Selection.Value) - 1)
Selection.EntireColumn.AutoFit
If Selection.ColumnWidth ColWidth Then
Selection.Value = Left(Selection.Value, Len(Selection.Value) - _
Len(SplitTextString(Count1 - 1)) - 1)
Count1 = Count1 - 1
End If
Selection.ColumnWidth = ColWidth
ActiveCell.Offset(0, 1).Value = Selection.Value
ActiveCell.Offset(1, 0).Select
Count2 = Count2 + 1
If Count2 Rw And Count1 < UBound(SplitTextString) _
Then Selection.EntireRow.Insert
End If
Loop

Selection.EntireColumn.Delete

End Sub


"Rob" wrote:

Hello anyone...
I hope that you can help me w/ this situation. I have a spreadsheet w/
alot of text in "one" cell. When I Format-Cells-Alignment- and
choose wrap text. It wraps the text until you get to the end of the
cell. At the end of the cell the text continues pass the right border.
I tried ajusting the "rows" hieght, but the text still continues, and I
have about 2 inchs of white space in the cell where I want this text to
wrap to. I increase the width of the column, but the text aligns to the
top and keeps going up as I widen the column. Plus widening the column
is not an option that the user wants on the spreadsheet, but I got
desperate. I have looked in my "Options" in the "Tool" menu. I know I
most likely choose every option in that dialog box. Still no results. I
have been working on this all day. My brain is now mushhhh :) Pls
help....