Split text cells in 70 character chunks in Excel

Question

I have an Excel file with a cell that includes the key to the record and another cell that has text for the key; the information is coming from a SQL Server database.

The text cell includes line feeds and blank rows, and I need to split the contents of this cell into as many 70-character rows as needed. For each row I need to use the same key value, as well as a 'line sequence' number. Regarding the text, I need to keep whole words, and respect the white lines and line breaks found in the original cell.

Below is an example of one of the cells (A1 is the key cell, and A2 is the text cell):

A1
ANUAL-LCD-FIX#0
A2
1-Limpieza general.
2-Revision de tornilleria en todo el equipo, reapretar de ser necesario.
3-Revision de pines, que no esten danados, reemplazar de ser necesario, (revisar con ingenieria).
4-Revision de la pantalla, que este funcional y que no este golpeada.

After splitting, this is what I need to get; please note that 3 columns (A, B and C) and 6 rows (1..6) would need to be created:

A1
ANUAL-LCD-FIX#0
B1
01
C1
1-Limpieza general.
A2
ANUAL-LCD-FIX#0
B2
02
C2
2-Revision de tornilleria en todo el equipo, reapretar de ser
A3
ANUAL-LCD-FIX#0
B3
03
C3
necesario.
A4
ANUAL-LCD-FIX#0
B4
04
C4
3-Revision de pines, que no esten danados, reemplazar de ser
A5
ANUAL-LCD-FIX#0
B5
05
C5
necesario, (revisar con ingenieria).
A6
ANUAL-LCD-FIX#0
B6
06
C6
4-Revision de la pantalla, que este funcional y que no este golpeada.

I have found some examples online that split cells, but the length of the cell being split is pre-determined, and they do not have white lines or line breaks; in my case, some of those cells are less than 70 characters, while others are much longer, so it is hard to know in advance how many rows will be needed to split each text cell.

Could anyone suggest me how to accomplish this? Let me know if more info or details are needed.

Thanks.

Answer 1

Try this code:

Sub SubNewList()
    
    'Declarations.
    Dim IntCharacterLimit As Integer
    Dim IntCounter01 As Integer
    Dim IntCounter02 As Integer
    Dim IntMarkerPart As Integer
    Dim DblTextOffsetFromKey As Double
    Dim RngDestination As Range
    Dim RngKeyList As Range
    Dim RngTarget As Range
    Dim StrMarker01 As String
    Dim StrMarker02 As String
    Dim StrTextWhole As String
    Dim StrTextPart01 As String
    Dim StrTextPart02 As String
    Dim WksNewSheet As Worksheet
    
    'Setting variables.
    Set RngKeyList = Sheets("Sheet1").Range("A2")
    DblTextOffsetFromKey = 1
    StrMarker01 = Chr(10)
    StrMarker02 = " "
    IntCharacterLimit = 70
    
    'Changing RngKeyList to cover the whole list.
    Set RngKeyList = RngKeyList.Parent.Range(RngKeyList, RngKeyList.End(xlDown))
    
    'Creating a new sheet.
    Set WksNewSheet = Sheets.Add(After:=RngKeyList.Parent)
    
    'Setting RngDestination in the new sheet.
    Set RngDestination = WksNewSheet.Cells(1, 1)
    
    'Creating headers.
    RngDestination.Value = "Key"
    RngDestination.Offset(0, 1).Value = "Seq"
    RngDestination.Offset(0, 2).Value = "Text"
    Set RngDestination = RngDestination.Offset(1, 0)
    
    'Covering each cell in RngKeyList.
    For Each RngTarget In RngKeyList
        
        'If the given cell is empty, the subroutine is terminated.
        If RngTarget.Value = "" Then Exit Sub
        
        'Setting variable.
        IntCounter01 = 0
        
        'Coping the Text value in StrTextWhole.
        StrTextWhole = RngTarget.Offset(0, DblTextOffsetFromKey).Value
        
        'Covering each part of StrTextWhole delimited by StrMarker01.
        For IntMarkerPart = 0 To UBound(VBA.Strings.Split(StrTextWhole, StrMarker01))
            
            'Checking if the given part is not blank.
            If VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart) <> "" Then
                
                'Checking if the lenght of the given part exceed IntCharacterLimit.
                If Len(VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart)) <= IntCharacterLimit Then
                    
                    'Reporting the Key value.
                    RngDestination.Offset(IntCounter01, 0).Value = RngTarget.Value
                    
                    'Reporting the Seq value.
                    RngDestination.Offset(IntCounter01, 1).Value = IntCounter01 + 1
                    
                    'Reporting the Text value.
                    RngDestination.Offset(IntCounter01, 2).Value = VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart)
                    
                    'Setting IntCounter01 for the new row.
                    IntCounter01 = IntCounter01 + 1
                    
                Else
                    
                    'Coping the given part of StrTextWhole (delimited by StrMarker01) in StrTextPart01.
                    StrTextPart01 = VBA.Strings.Split(StrTextWhole, StrMarker01)(IntMarkerPart)
                    
                    Do
                        
                        'Reporting the Key value.
                        RngDestination.Offset(IntCounter01, 0).Value = RngTarget.Value
                        
                        'Reporting the Seq value.
                        RngDestination.Offset(IntCounter01, 1).Value = IntCounter01 + 1
                        
                        'Setting variables.
                        IntCounter02 = 0
                        StrTextPart02 = ""
                        
                        'In the Do-Loop cycle: coping in StrTextPart02 every remaining part of StrTextPart01 delimited
                        'by StrMarker02 as long as StrTextPart02 lenght is less then IntCharacterLimit
                        Do
                            
                            'Checking StrTextPart02 is blank.
                            If StrTextPart02 = "" Then
                                StrTextPart02 = VBA.Strings.Split(StrTextPart01, StrMarker02)(IntCounter02)
                            Else
                                StrTextPart02 = StrTextPart02 & StrMarker02 & VBA.Strings.Split(StrTextPart01, StrMarker02)(IntCounter02)
                            End If
                            
                            'Setting IntCounter02 for the next part (delimited by StrMarker02) in StrTextPart01.
                            IntCounter02 = IntCounter02 + 1
                            
                            'Checking if all of StrTextPart01 has been covered.
                            If IntCounter02 > UBound(VBA.Strings.Split(StrTextPart01, StrMarker02)) Then Exit Do
                        
                        Loop Until Len(StrTextPart02 & StrMarker02 & VBA.Strings.Split(StrTextPart01, StrMarker02)(IntCounter02)) > IntCharacterLimit
                        
                        'Reporting the Text value.
                        RngDestination.Offset(IntCounter01, 2).Value = StrTextPart02
                        
                        'Setting IntCounter01 for the next row.
                        IntCounter01 = IntCounter01 + 1
                        
                        'Checking if all of StrTextPart01 has been covered.
                        If Len(StrTextPart01) - Len(StrTextPart02) - 1 <= 0 Then Exit Do
                        
                        'Cutting the part already covered of StrTextPart01.
                        StrTextPart01 = Right(StrTextPart01, Len(StrTextPart01) - Len(StrTextPart02))
                        
                    Loop
                End If
            End If
        Next
        
        'Setting RngDestination for the next RngTarget.
        Set RngDestination = WksNewSheet.Cells(1, 1).End(xlDown).Offset(1, 0)
        
    Next
    
End Sub

It assumes that the original list is placed with headers in cell A1 of a sheet named Sheet1 and is like the sample you have given. If that's not the case, edit the code accordingly. For example: you can edit the line Set RngKeyList = Sheets("Sheet1").Range("A2") to target the first cell of the Key column that contains data.

Answer 2

You can do this using Power Query

• Data / Get& Transform / from Table/Range
• Split to rows on the linefeed character
• Add column using a custom function to split on maximum of 70th character preceding space.
• Expand the splitted column

M Code

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

    //split by linefeed into new rows
    splitToRows = Table.ExpandListColumn(Table.TransformColumns(
        Source, {{"Text", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), 
        let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Text"),

    //split on maximum 70 characters but only whole words.
    #"Invoked Custom Function" = Table.AddColumn(splitToRows, "fnSplitOnSpace", each fnSplitOnSpace([Text], 70)),

    //remove unneeded column
    #"Removed Columns" = Table.RemoveColumns(#"Invoked Custom Function",{"Text"}),

    //rename column: Text
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"fnSplitOnSpace", "Text"}}),

    //expand list to new rows
    #"Expanded Text" = Table.ExpandListColumn(#"Renamed Columns", "Text")
in
    #"Expanded Text"

Requires a custom function.

• Create a new query from other sources/Blank Query
• Rename the query (Properties/Name): fnSplitOnSpace

M Code for custom function

//https://community.powerbi.com/t5/Desktop/Query-Editor-to-Split-the-Text-String/td-p/142110
//Marcel Beug

(TextString as text, LineLength as number) as list =>
    let
    fnWT = List.Generate(() => 
                  [TextPart      = if Text.Length(TextString) <= LineLength
                                   then TextString 
                                   else if Text.PositionOf(Text.Start(TextString,LineLength + 1)," ",Occurrence.Last) > -1
                                        then Text.Start(TextString,List.Min({LineLength + 1,Text.PositionOf(Text.Start(TextString,LineLength + 1)," ",Occurrence.Last)}))
                                        else Text.Start(TextString,List.Min({LineLength,Text.Length(TextString)})),
                   RemainingText = if Text.Length(TextString) <= LineLength
                                   then "" 
                                   else if Text.PositionOf(TextPart," ") > -1 
                                        then Text.Trim(Text.End(TextString,Text.Length(TextString)-Text.Length(TextPart)-1))
                                        else Text.Trim(Text.End(TextString,Text.Length(TextString)-Text.Length(TextPart)))],

                   each Text.Length([TextPart])>0,

                   each [TextPart      = if Text.Length([RemainingText]) <= LineLength
                                         then [RemainingText]
                                         else if Text.PositionOf(Text.Start([RemainingText],LineLength + 1)," ",Occurrence.Last) > -1
                                              then Text.Start([RemainingText],List.Min({LineLength + 1,Text.PositionOf(Text.Start([RemainingText],LineLength + 1)," ",Occurrence.Last)}))
                                              else Text.Start([RemainingText],List.Min({LineLength,Text.Length([RemainingText])})),
                         RemainingText = if Text.Length([RemainingText]) <= LineLength
                                         then ""
                                         else if Text.PositionOf(TextPart," ") > -1
                                              then Text.Trim(Text.End([RemainingText],Text.Length([RemainingText])-Text.Length(TextPart)-1))
                                              else Text.Trim(Text.End([RemainingText],Text.Length([RemainingText])-Text.Length(TextPart)))],

                   each [TextPart])
in
    fnWT

Original

Results