Customized text wrapping to new row (not within cell)

[Extivalis]

Hi All,

I know about the default text wrapping option, but without getting too in the weeds (as I'm dealing with inherited workbooks, macros, processes, etc), is there a way to make text in one column cut off once it reaches the beginning (or end, either way) or a specified column, but then continue in a new row? for example:

Turn
| C | D | E | F | G |H| I |
3] WOW LOOK AT THIS TEXT AND HOW IT JUST KEEPS GOING ON AND ON
4]
5]

Into
| C | D | E | F | G |H| I |
3] WOW LOOK AT THIS TEXT AND HOW IT JUST
4] KEEPS GOING ON AND ON
5]

-I'm trying to add this into an existing macro
-Changing Column widths and Row heights isn't really an option (my hands are tied on the final formatting, there would be other data in A, B, and I)
-Doesn't matter if the cutoff is the right edge of Column G or Column H, but the text will be left justified and entered in Column C

Thanks in advance

 

[Cubist]

Maybe this?

Book1.xlsb
	C	D	E	F	G	H	I	J
1	WOW LOOK AT THIS TEXT AND HOW IT JUST KEEPS GOING ON AND ON
2
3		WOW	LOOK	AT	THIS	TEXT	AND	HOW
4		IT	JUST	KEEPS	GOING	ON	AND	ON
Sheet7

Cell Formulas
Range	Formula
D3:J4	D3	=WRAPROWS(TEXTSPLIT(C1," "),7,"")
Dynamic array formulas.

 

[Jaafar Tribak]

For a cleaner solution, we should be measuring the cell text size and cutoff column using the win32 api but, we can use a hacky workaround by temporarly placing the code in a temporary textbox that is sized and formatted based on our requirements.

The following routine should do the job:

Public Sub Split_Cell_In_Two_Rows( _
    ByVal SourceCell As Range, _
    ByVal CutOffColumn As String, _
    ByVal DestRow1 As Long, _
    ByVal DestRow2 As Long, _
    ByVal DestColumn As Long _
)
    If Len(SourceCell) Then
        With ActiveSheet.Shapes.AddTextbox( _
            msoTextOrientationHorizontal, _
            0&, _
            Cells(Rows.Count, 1&).Left, _
            Range(SourceCell, Columns(CutOffColumn)).Width, _
            0& _
            )
            With .TextFrame2.TextRange
                .Parent.MarginLeft = 0&
                .ParagraphFormat.LeftIndent = 0&
                .ParagraphFormat.RightIndent = 0&
                .Font.Name = SourceCell.Font.Name
                .Font.Size = SourceCell.Font.Size
                .Font.Bold = SourceCell.Font.Bold
                .Font.Italic = SourceCell.Font.Italic
                .Text = SourceCell.Text
                Cells(DestRow1, DestColumn) = .Lines(1&)
                Cells(DestRow2, DestColumn) = Replace(.Text, .Lines(1&), "")
            End With
            .Delete
        End With
    End If
End Sub

Here is an example of how to use the routine above:
This will split the text in C1 @ Column F and place the result in cells C1 and C2

Sub Test()

    Split_Cell_In_Two_Rows _
            SourceCell:=Range("C1"), _
            CutOffColumn:="F", _
            DestRow1:=1, _
            DestRow2:=2, _
            DestColumn:=3
         
End Sub

Ideally, this routine should be tweaked to become more generic so that it works for splitting a cell into more than two rows.

 

[rlv01]

A VBA approach. This assumes that cells with text that might need to be split to multiple rows are in column A.

Sub SplitLongTextExample()
    Dim WS As Worksheet, WS2 As Worksheet
    Dim rng As Range, rng2 As Range, R As Range
    Dim I As Long, MaxLen As Long
    Dim S As String, Line As String
    
    Application.ScreenUpdating = False
    
    Set WS = ActiveSheet
    Set WS2 = ThisWorkbook.Worksheets.Add  'temp sheet
    Set rng2 = WS2.Range("A1")
    
    With WS
        Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    MaxLen = 40 '40 chars - this is an arbitrary value
    I = 1
    For Each R In rng
        If Len(R.Value) > MaxLen Then 'split into differnt rows
            Line = R.Value
            Do While Len(Line) > MaxLen
                S = RTrim(Left(Left(Line, MaxLen), InStrRev(Left(Line, MaxLen), " ")))
                rng2.Cells(I, 1).Value = Trim(S)
                I = I + 1
                Line = Mid(Line, Len(S) + 1, Len(Line))
            Loop
            If Trim(Line) <> "" Then
                rng2.Cells(I, 1).Value = Trim(Line)
            End If
        Else
            rng2.Cells(I, 1).Value = R.Value 'no need to split
        End If
        I = I + 1
    Next R
    
    If rng.Rows.Count + 1 < I Then
        WS2.UsedRange.Copy WS.Range("A2")
    End If
    
    Application.DisplayAlerts = False
    WS2.Delete 'temp sheet
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Extivalis]

For a cleaner solution, we should be measuring the cell text size and cutoff column using the win32 api but, we can use a hacky workaround by temporarly placing the code in a temporary textbox that is sized and formatted based on our requirements.

The following routine should do the job:

Public Sub Split_Cell_In_Two_Rows( _
    ByVal SourceCell As Range, _
    ByVal CutOffColumn As String, _
    ByVal DestRow1 As Long, _
    ByVal DestRow2 As Long, _
    ByVal DestColumn As Long _
)
    If Len(SourceCell) Then
        With ActiveSheet.Shapes.AddTextbox( _
            msoTextOrientationHorizontal, _
            0&, _
            Cells(Rows.Count, 1&).Left, _
            Range(SourceCell, Columns(CutOffColumn)).Width, _
            0& _
            )
            With .TextFrame2.TextRange
                .Parent.MarginLeft = 0&
                .ParagraphFormat.LeftIndent = 0&
                .ParagraphFormat.RightIndent = 0&
                .Font.Name = SourceCell.Font.Name
                .Font.Size = SourceCell.Font.Size
                .Font.Bold = SourceCell.Font.Bold
                .Font.Italic = SourceCell.Font.Italic
                .Text = SourceCell.Text
                Cells(DestRow1, DestColumn) = .Lines(1&)
                Cells(DestRow2, DestColumn) = Replace(.Text, .Lines(1&), "")
            End With
            .Delete
        End With
    End If
End Sub

Here is an example of how to use the routine above:
This will split the text in C1 @ Column F and place the result in cells C1 and C2

Sub Test()

    Split_Cell_In_Two_Rows _
            SourceCell:=Range("C1"), _
            CutOffColumn:="F", _
            DestRow1:=1, _
            DestRow2:=2, _
            DestColumn:=3
        
End Sub

View attachment 108815


View attachment 108816


Ideally, this routine should be tweaked to become more generic so that it works for splitting a cell into more than two rows.

This looks like what I'm shooting for, but I think I'm misunderstanding something on your example b/c my excel keeps giving the error "Compile error: Expected: expression", and highlighting the following in red:

SourceCell:=Range("C4"), _
CutOffColumn:="G", _
DestRow1:=4, _
DestRow2:=5, _
DestColumn:=3

 

[Extivalis]

For a cleaner solution, we should be measuring the cell text size and cutoff column using the win32 api but, we can use a hacky workaround by temporarly placing the code in a temporary textbox that is sized and formatted based on our requirements.

The following routine should do the job:

Public Sub Split_Cell_In_Two_Rows( _
    ByVal SourceCell As Range, _
    ByVal CutOffColumn As String, _
    ByVal DestRow1 As Long, _
    ByVal DestRow2 As Long, _
    ByVal DestColumn As Long _
)
    If Len(SourceCell) Then
        With ActiveSheet.Shapes.AddTextbox( _
            msoTextOrientationHorizontal, _
            0&, _
            Cells(Rows.Count, 1&).Left, _
            Range(SourceCell, Columns(CutOffColumn)).Width, _
            0& _
            )
            With .TextFrame2.TextRange
                .Parent.MarginLeft = 0&
                .ParagraphFormat.LeftIndent = 0&
                .ParagraphFormat.RightIndent = 0&
                .Font.Name = SourceCell.Font.Name
                .Font.Size = SourceCell.Font.Size
                .Font.Bold = SourceCell.Font.Bold
                .Font.Italic = SourceCell.Font.Italic
                .Text = SourceCell.Text
                Cells(DestRow1, DestColumn) = .Lines(1&)
                Cells(DestRow2, DestColumn) = Replace(.Text, .Lines(1&), "")
            End With
            .Delete
        End With
    End If
End Sub

Here is an example of how to use the routine above:
This will split the text in C1 @ Column F and place the result in cells C1 and C2

Sub Test()

    Split_Cell_In_Two_Rows _
            SourceCell:=Range("C1"), _
            CutOffColumn:="F", _
            DestRow1:=1, _
            DestRow2:=2, _
            DestColumn:=3
      
End Sub

View attachment 108815


View attachment 108816


Ideally, this routine should be tweaked to become more generic so that it works for splitting a cell into more than two rows.

 

[Extivalis]

I realize this may have something to do with other coding in the existing macros I inherited, but: it looks like when text is split into a second row, it's pushing all the other cells in the column down a row. Is it possible to not do that? For example, when the coding you suggested is run, there should be text in every 3rd row of column C, starting with C4 (so C4, C7, C10, etc, etc), and when the excess text from C4 is moved to C5, I would still need the text in C7 to start in C7 rather than getting bumped to C8. (luckily, there should never be so much text getting split that it would cause an overlap).

 

[Extivalis]

A VBA approach. This assumes that cells with text that might need to be split to multiple rows are in column A.

Sub SplitLongTextExample()
    Dim WS As Worksheet, WS2 As Worksheet
    Dim rng As Range, rng2 As Range, R As Range
    Dim I As Long, MaxLen As Long
    Dim S As String, Line As String
   
    Application.ScreenUpdating = False
   
    Set WS = ActiveSheet
    Set WS2 = ThisWorkbook.Worksheets.Add  'temp sheet
    Set rng2 = WS2.Range("A1")
   
    With WS
        Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
   
    MaxLen = 40 '40 chars - this is an arbitrary value
    I = 1
    For Each R In rng
        If Len(R.Value) > MaxLen Then 'split into differnt rows
            Line = R.Value
            Do While Len(Line) > MaxLen
                S = RTrim(Left(Left(Line, MaxLen), InStrRev(Left(Line, MaxLen), " ")))
                rng2.Cells(I, 1).Value = Trim(S)
                I = I + 1
                Line = Mid(Line, Len(S) + 1, Len(Line))
            Loop
            If Trim(Line) <> "" Then
                rng2.Cells(I, 1).Value = Trim(Line)
            End If
        Else
            rng2.Cells(I, 1).Value = R.Value 'no need to split
        End If
        I = I + 1
    Next R
   
    If rng.Rows.Count + 1 < I Then
        WS2.UsedRange.Copy WS.Range("A2")
    End If
   
    Application.DisplayAlerts = False
    WS2.Delete 'temp sheet
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

I realize this may have something to do with other coding in the existing macros I inherited, but: it looks like when text is split into a second row, it's pushing all the other cells in the column down a row. Is it possible to not do that? For example, when the coding you suggested is run, there should be text in every 3rd row of column C, starting with C4 (so C4, C7, C10, etc, etc), and when the excess text from C4 is moved to C5, I would still need the text in C7 to start in C7 rather than getting bumped to C8. (luckily, there should never be so much text getting split that it would cause an overlap).

 

[rlv01]

For example, when the coding you suggested is run, there should be text in every 3rd row of column C, starting with C4 (so C4, C7, C10, etc, etc),

That is a very important detail to omit. One with a major impact on how any solution would be coded. so of course the code I posted won't do that. Please use the free addin XL2BB to post some sample data that shows both "before" data and the "after" result.

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com