Wrap Text Into Next Row, Not The Same Row

[miketurn]

Hello Everyone,

I would imagine that this cannot be done because I don't think Excel would be able to know how to do this but I figured I would ask just in case. (I have done some research for this as well with no positive info found)

Say you have a row of text that goes beyond its columns width by a good amount
I am looking for I would guess, some kind of Macro that would allow me to select that row, apply a macro and it would....
Take the text within the row and break it up into rows of text based on the width of the column.

I am aware that you can turn on a text wrap and it will automatically change the height of the row based on the text within it.
That is not what I am looking for, I want it to break the text down into separate rows using the columns width to know when to move the text to the next row. It would break the text down into as many rows as it needs.

Simplistic Example

So text is in COLUMN A - ROW 10 and the COLUMN A width ends right after apple

COLUMN A
ROW 10 | apple | orange banana


I want it to do this

COLUMN A
ROW 10 | apple |
ROW 11 | orange |
ROW 12 | banana |


Like I said I would imagine Excel does not have the ability to know how to do this, but maybe?
I have seen some pretty incredible macros created by others, so I figured I would take a shot to see if anyone has any ideas of how this can be done.

Thank You to anyone who reads this

 

[Rick Rothstein]

Sorry for the delay in getting back to you... I lost track of this thread and only just rediscovered it.

The following macro will justify each cell with data, place a blank row between each justified set of cells, keep the color of the cell being justified and work for one or more adjacent columns. Note that the first justified cell in each column will start on the first row of the selection, so that if you select a blank row above your actual data, then the justified text will start from that blank row... if do not want the first row of data to move when justified, start your selection on that row.

[table="width: 500"]
[tr]
	[td]Sub JustifyTextDown()
  Dim R As Long, C As Long, StartRow As Long, FirstInCol As Boolean
  Dim Begin As Range, Addr As String, Data As Variant
  If Selection.Areas.Count > 1 Then
    MsgBox "This code only works on contiguous selections!"
    Exit Sub
  Else
    Application.DisplayAlerts = False
    StartRow = Selection(1).Row
    ReDim Data(1 To Selection.Rows.Count, 1 To Selection.Columns.Count)
    For R = 1 To UBound(Data, 1)
      For C = 1 To UBound(Data, 2)
        With Selection(1).Offset(R - 1, C - 1)
          If Len(.Value) Then Data(R, C) = .Interior.Color
          Data(R, C) = Data(R, C) & Chr(1) & .Value
        End With
      Next
    Next
    Selection.Clear
    For C = 1 To UBound(Data, 2)
      Set Begin = Cells(StartRow, Selection.Column + C - 1)
      FirstInCol = True
      For R = 1 To UBound(Data, 1)
        If Len(Data(R, C)) > 1 Then
          If Not FirstInCol Then Set Begin = Cells(Rows.Count, Selection.Column + C - 1).End(xlUp).Offset(2 + (R = 1))
          With Begin
            Addr = .Address
            .Value = Mid(Data(R, C), InStr(Data(R, C), Chr(1)) + 1)
            .Justify
            Range(Addr, Cells(Rows.Count, Range(Addr).Column).End(xlUp)).Interior.Color = Val(Data(R, C))
          End With
          FirstInCol = False
        End If
      Next
    Next
    Application.DisplayAlerts = True
  End If
End Sub[/td]
[/tr]
[/table]

 

[miketurn]

@Rick Rothstein,
Thank You so much for coming back and for sticking with me on this one. I gave your new macro a try, it does work at wrapping the text to the column width but it now doesn't seem to have the part where it creates new rows for the text that it wraps, like your first macro does.
Your original macro functions exactly in the way that I am looking for, the only thing is instead of wrapping each word individually to a new row, I was looking for it to wrap to the column width (which your new macro provides)

Your Original Macro

Sub SplitSelectedCellDown()
  Dim X As Long, NextCellFilled As Boolean, Words() As String
  With Selection
    If .Count > 1 Then
      MsgBox "You are only allowed to select one cell!"
    Else
      Words = Split(Application.Trim(.Value & " "))
      NextCellFilled = Len(Selection.Offset(1).Value)
      .Offset(1).Resize(UBound(Words) - NextCellFilled).Insert xlShiftDown
      .Resize(UBound(Words) + 1) = Application.Transpose(Words)
    End If
  End With
End Sub

I will post some examples right after this post if you are still interested in working on it.
Again, thank you very much for your help thus far.

 

[miketurn]

@Rick Rothstein
The new macro you provided in post #21 of this thread does the following....
(Note these are meant to be general examples not specific to these cell locations)
(For this example say the background fill for A1-A2 is yellow and the A3-A5 is orange)....

Here is an example of how your new macro currently works
BEFORE
|______________A________________ |_________B_________ |
1 This is text I would like to wrap based on the width of column A in Excel and have it wrap into row below it
2
3 Important Data
4
5

If you select A1 and apply this macro you get the following

AFTER
|______________A________________ |_________B_________ |
1 This is text I would like to wrap based
2 on the width of column A in Excel and
3 have it wrap into row below it
4
5

As you can see the current macro wraps the text from A1 over the "Important Data" in A3




MODIFICATION #1
Looking for it to do the following where it adds new (yellow filled) rows 2 and 3 for the wrapped text causing the "Important Data" from A3 into being A5 (still with its orange fill color).
|______________A________________ |_________B_________ |
1 This is text I would like to wrap based
2 on the width of column A in Excel and
3 have it wrap into row below it
4
5 Important Data

MODIFICATION #2
In this example A1 has a yellow background and the "Important Data" is now in cell A2 with an orange background.

BEFORE
|______________A________________ |_________B_________ |
1 This is text I would like to wrap based on the width of column A in Excel and have it wrap into row below it
2 Important Data
3
4
5

AFTER
|______________A________________ |_________B_________ |
1 This is text I would like to wrap based
2 on the width of column A in Excel and
3 have it wrap into row below it
4
5 Important Data

New yellow rows are added for wrapped text which are A2 and A3, new empty yellow row is added to A4 because the macro detects the "Important Data" from A2 and provides an empty row between them.

Your original macro amazingly can already achieve MODIFICATION 1 and 2.

Anyways, if you are still interested, I hope this helps.
Regardless though I thank you so much for even creating the two macros that you have provided.

 

[Rick Rothstein]

I had set the code up assuming you would select the range of cells (those with data to be justifies along with those that would not change when justified), but in thinking about it now, there is no need for me to make you do that when I can make the code do it instead. Here is my macro modified such that you only have to select the cell or cells you want to start with (even if that cell or cells will not change when justified or even if they are blank) and the code will handle the rest of the column(s) automatically. Note the plurals in that last sentence... you are not restricted to only one column with this code... as long as the cells are contiguous across a single row, this code will automatically justify all cells from that selected row downward for all columns in the selection. So, what that means is if you select, say cells B3:D3, then all cells in Columns B, C and D starting with Row 3 will be justified if their text is long enough to require it. Here is the code...

[table="width: 500"]
[tr]
	[td]Sub JustifyTextDown()
  Dim R As Long, C As Long, StartRow As Long, FirstInCol As Boolean
  Dim Begin As Range, Addr As String, data As Variant
  If Selection.Areas.Count > 1 Then
    MsgBox "This code only works on contiguous selections!"
    Exit Sub
  Else
    Application.DisplayAlerts = False
    StartRow = Selection(1).Row
    Range(Selection, Selection.EntireColumn.Find("*", , xlValues, , xlRows, xlPrevious)).Select
    ReDim data(1 To Selection.Rows.Count, 1 To Selection.Columns.Count)
    For R = 1 To UBound(data, 1)
      For C = 1 To UBound(data, 2)
        With Selection(1).Offset(R - 1, C - 1)
          If Len(.Value) Then data(R, C) = .Interior.Color
          data(R, C) = data(R, C) & Chr(1) & .Value
        End With
      Next
    Next
    Selection.Clear
    For C = 1 To UBound(data, 2)
      Set Begin = Cells(StartRow, Selection.Column + C - 1)
      FirstInCol = True
      For R = 1 To UBound(data, 1)
        If Len(data(R, C)) > 1 Then
          If Not FirstInCol Then Set Begin = Cells(Rows.Count, Selection.Column + C - 1).End(xlUp).Offset(2 + (R = 1))
          With Begin
            Addr = .Address
            .Value = Mid(data(R, C), InStr(data(R, C), Chr(1)) + 1)
            .Justify
            Range(Addr, Cells(Rows.Count, Range(Addr).Column).End(xlUp)).Interior.Color = Val(data(R, C))
          End With
          FirstInCol = False
        End If
      Next
    Next
    Selection.Rows(1).Select
    Application.DisplayAlerts = True
  End If
End Sub[/td]
[/tr]
[/table]

 

[miketurn]

@Rick Rothstein
Thank You so much for sticking with me on this one, and providing me another macro to try.
I have been testing out the macro that you have provided and have run into a couple of things, but I want to understand them a little more before I mention them.

I did have a quick question though, with this macro in mind, do you know if it is possible through VB to be able to have "New" rows added for the text that is being wrapped into the rows below? Like is there a way for the language to know how many rows it will need to wrap the text into and instead of putting the text into existing rows, have them create "New" ones for the wrapped text?

Thank You again for your help

 

[miketurn]

@Rick Rothstein
I have a feeling I lost you but just in case you are still interested.

My question above about being able to add "new" rows for the wrapped text would just allow for the ability to run this macro on specific selected instances as opposed to having to apply the macro to the entire spreadsheet, which can get scary.
The "new" rows would be able to just shift all the data / empty rows / color background fills / etc down all at once, keeping all that information together.

Hopefully this is possible to do, but I have never seen any VB coding that would be able to determine how many "new" rows are needed, not sure if you have, or if anyone could mention if this could be done or not, it would be nice to know.

The macro you provided is impressive, but as I mentioned above (just due to the nature of it applying to the entire spreadsheet) I ran into quite a few wacky instances which would require quite a bit of work to be done, which I am not going to ask of you to do.

If the adding "new" rows cannot be done, I might have a hacked up idea that may work, but I would probably create a new post for it.

As I have mentioned either way thank you so much for the help that you have provided me not just on this thread but on other threads as well, you have been extremely helpful which I appreciate.

 

[Rick Rothstein]

@Rick Rothstein
I have a feeling I lost you but just in case you are still interested.

My question above about being able to add "new" rows for the wrapped text...

If you mean add physical new rows to the worksheet and place each wrapped line into its own worksheet row... I do not know how to do that. As far as I can tell, the wrap point for each justified row of text within a cell is not identifiable, so I do not know how to split the text into separate rows.

 

[miketurn]

@Rick Rothstein
Thank You so much for getting back to me, yeah I didn't think it was possible, that would probably be a tough thing to have Excel recognize.

The "hacked up" idea I had (although I have to think it through a little bit more) was to combine a couple of macros that others have helped me with.
So say....
1.) Select the single cell that contains the text that needs to be wrapped
2.) Have it automatically add 5-10 "new" rows below it with the same background color.
3.) Somehow have the macro expand its selection to include these "new" 5-10 rows.
3.) Wrap the text into those "new" rows (Using your macro or @My Aswer Is This macro)
4.) Apply macro that removes all empty rows except for one within your selection (which @Peter_SSs created)

Not exactly sure how Excel would handle something like this, like how smooth it will look and react on screen.
Don't know if I will be able to get it to work or not, if I run into any issues I will probably make a new thread post for it if you or anyone else is interested.

But again Thank You so much for all of your help, I see you helping other people out a great deal, and I just want you to know that it is very much appreciated.

 

[miketurn]

SUCCESS!
I played around with the idea I had above, and was able to get it to work.
Obviously I am not a macro creator so it is a rather hacked up macro, but so far it works.
I don't think anyone will use this other than me, but maybe something here will help someone out someday in the future, so I figured I would share it.
Thank You again to everyone involved.

Sub TextWrap() 
    ActiveCell.Offset(1).EntireRow.Insert 
    ActiveCell.Offset(1).EntireRow.Insert 
    ActiveCell.Offset(1).EntireRow.Insert 
    ActiveCell.Offset(1).EntireRow.Insert 
    ActiveCell.Offset(1).EntireRow.Insert 
 
    Selection.Resize(7).Select 
  
Application.DisplayAlerts = False 
Dim C As Range 
    For Each C In Selection 
    C.Justify 
    Next 

 
  Dim rA As Range, rBlanks As Range 
   
  If Selection.Count > 1 Then 
    On Error Resume Next 
    Set rBlanks = Selection.SpecialCells(xlBlanks) 
    On Error GoTo 0 
    If Not rBlanks Is Nothing Then 
      Application.ScreenUpdating = False 
      For Each rA In rBlanks.Areas 
        With rA 
          If .Rows.Count > 1 Then .Resize(.Rows.Count - 1).EntireRow.Delete 
        End With 
      Next rA 
      Application.ScreenUpdating = True 
    End If 
  End If 
 
Selection.Resize(1).Select 
End Sub

 

[miketurn]

@Rick Rothstein

My above method does work, but when thinking about this a little more I was wondering if maybe the latest macro you supplied for this could be tweaked a little.
Only if each of these items are possible, and also only if you are still interested in updating it of course.

TWEAKS
1.) This would probably be the most important one.
Would it be possible to just select the SINGLE cell that has the text that goes beyond Column A width needed to be wrapped and just apply the macro to this SINGLE cell instead of performing this macro to the entire sheet? Is there some kind of macro coding that could stop the macro after applying it to this SINGLE selected cell, maybe by detecting the next completely empty row after the text to know to stop there or some other method?

2.) This one is NOT extremely important, but sometimes I add a color fill to Column B, no text data though.
Your current macro INSERTS the wrapped text in Column A which shifts everything below it down including the Column A background fill colors.
When it does this the color filled cells in Column A go beyond the color filled cells I have in Column B.
Would it be possible to somehow when having your macro INSERT these rows into Column A, to also shift the same amount of rows in Column B as well, replicating the same fill colors applied to Column B? So say Column B was filled in the color black, black rows would be inserted in Column B in the same amount of rows that are inserted into Column A (so they would line up correctly at the bottom)

3.) Your latest macro adds a space between text if needed and doesn't if it is not needed (As I requested / explained in my post above #23)
If a space IS needed, your macro will insert a row, but it inserts a blank no fill color row, would it be possible to edit this to make it be the same color fill as the original cell that contains the text to wrap?

Again I thank you for all your help, the fact that you spend so much time helping me is greatly appreciated.
I find that I often give myself a headache trying to come up with how to explain what I am looking for, so just the fact that you not only read this, you understand what I am asking, and you actually create tools that achieve what I am looking for is extremely amazing to me, so again thank you very much for your help.