Page 1 of 2 12 LastLast
Results 1 to 10 of 16

Thread: Wrap Text On Spaces Up To A Maximum Number Of Characters Per Line

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13

    Wrap Text On Spaces Up To A Maximum Number Of Characters Per Line

    NOTE: The code in this message assumes your text does not have any Line Feeds in it. If your code does have Line Feeds, then use the code in Message #16 instead.

    This question has come up several times in newsgroups and forums across the years, and it just did so again in another forum I visit, so I thought I would share the solution I posted in response here in this forum. To rephrase the question... you have a text string that you want to wrap into individual lines, with a prescribed maximum number of characters per line, but the line wrapping should only take place at a space between words. As an example, let's say the text string is this...

    Today is a fine day to go outside because the weather is so nice.

    and you want to line wrap it with no more than 25 characters on any single line. This is how the text should look (remember, we are wrapping text at a blank space only)...

    Today is a fine day to go
    outside because the
    weather is so nice.

    If, on the other hand, we were to allow a maximum of 35 characters per line, then the wrapped text would look like this instead...

    Today is a fine day to go outside
    because the weather is so nice.

    Okay, here is a UDF (user defined function) that will perform the appropriate line wrapping (the first argument is the text you want to wrap and the second argument is the maximum number of characters per line)...

    Code:
    '  Turn the Cell Format "Wrap text" setting
    '  on for the cell containing this UDF
    Function WrapText(CellWithText As String, MaxChars) As String
      Dim Space As Long, Text As String, TextMax As String
      Text = CellWithText
      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
      WrapText = WrapText & Text
    End Function
    If you would rather do the line wrapping using a macro to process an entire column of text rather than using individual UDF formulas, then here is such a macro...

    Code:
    Sub WrapTextOnSpacesWithMaxCharactersPerLine()
      Dim Text As String, TextMax As String, SplitText As String
      Dim Space As Long, MaxChars As Long
      Dim Source As Range, CellWithText As Range
      
      ' With offset as 1, split data will be adjacent to original data
      ' With offset = 0, split data will replace original data
      Const DestinationOffset As Long = 1
    
      MaxChars = Application.InputBox("Maximum number of characters per line?", Type:=1)
      If MaxChars <= 0 Then Exit Sub
      On Error GoTo NoCellsSelected
      Set Source = Application.InputBox("Select cells to process:", Type:=8)
      On Error GoTo 0
      For Each CellWithText In Source
        Text = CellWithText.Value
        SplitText = ""
        Do While Len(Text) > MaxChars
          TextMax = Left(Text, MaxChars + 1)
          If Right(TextMax, 1) = " " Then
            SplitText = SplitText & RTrim(TextMax) & vbLf
            Text = Mid(Text, MaxChars + 2)
          Else
            Space = InStrRev(TextMax, " ")
            If Space = 0 Then
              SplitText = SplitText & Left(Text, MaxChars) & vbLf
              Text = Mid(Text, MaxChars + 1)
            Else
              SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
              Text = Mid(Text, Space + 1)
            End If
          End If
        Loop
        CellWithText.Offset(, DestinationOffset).Value = SplitText & Text
      Next
      Exit Sub
    NoCellsSelected:
    End Sub
    Note the comment above the line of code where the DestinationOffset constant is set (the Const statement).


    HOW TO INSTALL UDFs
    ------------------------------------
    If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use WrapText just like it was a built-in Excel function. For example (assuming 35 characters per line),

    =WrapText(A1,35)


    HOW TO INSTALL MACROs
    ------------------------------------
    If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (WrapTextOnSpacesWithMaxCharactersPerLine) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm).
    Last edited by Rick Rothstein; 12-24-2016 at 03:45 PM.

  2. #2
    Junior Member
    Join Date
    Nov 2014
    Posts
    6
    Rep Power
    0
    Hi Rick.
    I've been using your macro for months now, and it has become essential for my workflow. Thanks a lot!
    But since I work a lot with text in Excel, I think it can be slightly improved. Let me explain...

    I often need to wrap text in cells with existing linebreaks. Example (original cell):

    TITLE

    Chapter 1
    Today is a fine day to go outside because the weather is so nice.


    Note: there are three linebreaks in this cell, at 1st, 2nd and 3rd line.
    Alas, your macro doesn't consider existing linebreaks.
    Running the macro with a 35 characters limit, I obtain:

    TITLE

    Chapter 1
    Today is a fine
    day to go outside because the
    weather is so nice.


    But it's not correct, because I'd need this:

    TITLE

    Chapter 1
    Today is a fine day to go outside
    because the weather is so nice.


    Do you think your macro can be tweaked for this purpose?

    Thanks in advance!



    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA


    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwplzlpYpmRqjGZem14AaABAg. 9hrvbYRwXvg9ht4b7z00X0
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgyOGlCElBSbfPIzerF4AaABAg. 9hrehNPPnBu9ht4us7TtPr
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwHjKXf3ELkU4u4j254AaABAg. 9hr503K8PDg9ht5mfLcgpR
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw1-OyZiDDxCHM2Rmp4AaABAg.9hqzs_MlQu-9ht5xNvQueN
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9htG01cKBzX
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htJ6TpIOXR
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwMKwGZpDjv7vi7pCx4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugw6UrV69zpeKvLOeOV4AaABAg. 9ht16tzryC49htOKs4jh3M
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxVW-am20rQ5GFuJ9F4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg. 9htWqRrSIfP9i-fyT84gqd
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugygb0YiLOI7fG1zQSx4AaABAg. 9htWqRrSIfP9i-kIDl-3C9
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i57J9GEOUB
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i58MGeM8Lg
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz0Uy2bCSCTb1W-0_14AaABAg.9htChVuaX9W9i59prk5atY
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgwaWs6XDXdQybNb8tZ4AaABAg. 9i5yTldIQBn9i7NB1gjyBk
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=UgxV9eNHvztLfFBGsvZ4AaABAg. 9i5jEuidRs99i7NUtNNy1v
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugx2zSXUtmLBSDoNWph4AaABAg. 9i3IA0y4fqp9i7NySrZamd
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9i7Qs8kxEqH
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9i7TqGQYqTz
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAJSNws8Zz
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAJvZ6kmlx
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAK0g1dU7i
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKCDqNmnF
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKHVSTGHy
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKSBKPcJ6
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKgL6lrcT
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKlts8hKZ
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAKrX7UPP0
    https://www.youtube.com/watch?v=LuAipOW8BNQ&lc=Ugz4oMZ09MKcExYlWf94AaABAg. 9hwsCHaKX6A9iAL5MSjWpA
    Last edited by DocAElstein; 07-09-2023 at 08:00 PM.

  3. #3
    Junior Member
    Join Date
    Nov 2014
    Posts
    3
    Rep Power
    0

    Question Adjustment

    Using the macro for an entire column,
    Instead of wrapping the text,
    How would you either insert a delimiter into this location,
    OR
    Separate data into cells to the right (instead of below)


    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA


    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://eileenslounge.com/viewtopic.php?p=317218#p317218
    https://eileenslounge.com/viewtopic.php?p=316955#p316955
    https://eileenslounge.com/viewtopic.php?p=316955#p316955
    https://eileenslounge.com/viewtopic.php?p=316940#p316940
    https://eileenslounge.com/viewtopic.php?p=316927#p316927
    https://eileenslounge.com/viewtopic.php?p=317014#p317014
    https://eileenslounge.com/viewtopic.php?p=317006#p317006
    https://eileenslounge.com/viewtopic.php?p=316935#p316935
    https://eileenslounge.com/viewtopic.php?p=316875#p316875
    https://eileenslounge.com/viewtopic.php?p=316254#p316254
    https://eileenslounge.com/viewtopic.php?p=316280#p316280
    https://eileenslounge.com/viewtopic.php?p=315915#p315915
    https://eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315744#p315744
    https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315680#p315680
    https://eileenslounge.com/viewtopic.php?p=315743#p315743
    https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
    https://eileenslounge.com/viewtopic.php?p=314950#p314950
    https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
    https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
    https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 05-20-2024 at 03:56 PM.

  4. #4
    Junior Member
    Join Date
    Nov 2014
    Posts
    6
    Rep Power
    0
    Last edited by DocAElstein; 11-06-2023 at 04:08 PM.

  5. #5
    Junior Member
    Join Date
    Nov 2014
    Posts
    3
    Rep Power
    0

    Question RE:

    with a delimiter I can split cell into the corresponding columns to the right using text to columns. (doing the same as splitting the cells into those to the right)

    this would be to split a cell that contains a list of words into several cells in the same row, separating at the last space within a maximum of 50 characters


    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 06-12-2023 at 05:46 PM.

  6. #6
    Junior Member
    Join Date
    Nov 2014
    Posts
    6
    Rep Power
    0
    Thanks, but it seems a step backwards.
    Rick's macro (with a tweak) would be more efficient in my workflow.

  7. #7
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    @ Rick, I took the freedom to tweak your code to adjust the linebreaks.

    Code:
    Function WrapText(CellWithText As String, MaxChars) As String
        Dim Space As Long, Text As String, TextMax As String
        Dim vLine As Variant, i As Long
        
        vLine = Split(CellWithText, Chr(10))
        
        For i = 0 To UBound(vLine)
            Text = vLine(i)
            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
            WrapText = WrapText & Text & Chr(10)
        Next
        
        WrapText = IIf(Right(WrapText, 1) = Chr(10), Left(WrapText, Len(WrapText) - 1), WrapText)
        
    End Function
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  8. #8
    Junior Member
    Join Date
    Nov 2014
    Posts
    6
    Rep Power
    0
    Thank you very much, Admin!

    I'm sorry to ask, but do you think you can tweak the macro too?
    (it would be a time-saver)

  9. #9
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by Admin View Post
    @ Rick, I took the freedom to tweak your code to adjust the linebreaks.

    Code:
    Function WrapText(CellWithText As String, MaxChars) As String
        Dim Space As Long, Text As String, TextMax As String
        Dim vLine As Variant, i As Long
        
        vLine = Split(CellWithText, Chr(10))
        
        For i = 0 To UBound(vLine)
            Text = vLine(i)
            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
            WrapText = WrapText & Text & Chr(10)
        Next
        
        WrapText = IIf(Right(WrapText, 1) = Chr(10), Left(WrapText, Len(WrapText) - 1), WrapText)
        
    End Function
    I know it is some two years later, but I am thinking I missed the significance of your tweak back then (or maybe I missed the message altogether, I am no longer sure at this late date); however, I have a different way to tweak the code to allow for embedded line feeds. My tweak handles everything within the confines of the exising Do..Loop thus eliminating the need to Split the text and handle the resultant array's elements in a outer loop.
    Code:
    Function WrapText(CellWithText As String, MaxChars) As String
      Dim Space As Long, LF As Long, Text As String, TextMax As String
      Text = CellWithText
      Do While Len(Text) > MaxChars
        TextMax = Left(Text, MaxChars + 1)
        LF = InStr(TextMax, vbLf)
        If LF Then
          WrapText = WrapText & Left(TextMax, LF)
          Text = Mid(Text, LF + 1)
        Else
          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
        End If
      Loop
      WrapText = WrapText & Text
    End Function
    and here is the tweak for my subroutine...
    Code:
    Sub WrapTextOnSpacesWithMaxCharactersPerLine() Dim Text As String, LF As Long, TextMax As String, SplitText As String Dim Space As Long, MaxChars As Long Dim Source As Range, CellWithText As Range ' With offset as 1, split data will be adjacent to original data ' With offset = 0, split data will replace original data Const DestinationOffset As Long = 1 MaxChars = Application.InputBox("Maximum number of characters per line?", Type:=1) If MaxChars <= 0 Then Exit Sub On Error GoTo NoCellsSelected Set Source = Application.InputBox("Select cells to process:", Type:=8) On Error GoTo 0 For Each CellWithText In Source Text = CellWithText.Value SplitText = "" Do While Len(Text) > MaxChars TextMax = Left(Text, MaxChars + 1) LF = InStr(TextMax, vbLf) If LF Then SplitText = SplitText & Left(TextMax, LF) Text = Mid(Text, LF + 1) Else If Right(TextMax, 1) = " " Then SplitText = SplitText & RTrim(TextMax) & vbLf Text = Mid(Text, MaxChars + 2) Else Space = InStrRev(TextMax, " ") If Space = 0 Then SplitText = SplitText & Left(Text, MaxChars) & vbLf Text = Mid(Text, MaxChars + 1) Else SplitText = SplitText & Left(TextMax, Space - 1) & vbLf Text = Mid(Text, Space + 1) End If End If End If Loop CellWithText.Offset(, DestinationOffset).Value = SplitText & Text Next Exit Sub NoCellsSelected: End Sub
    Last edited by Rick Rothstein; 12-20-2016 at 10:01 AM.

  10. #10
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Code:
    Sub WrapTextOnSpacesWithMaxCharactersPerLine()
      
        Dim Text As String, TextMax As String, SplitText As String
        Dim Space As Long, MaxChars As Long
        Dim Source As Range, CellWithText As Range, vLine, i As Long
        
        ' With offset as 1, split data will be adjacent to original data
        ' With offset = 0, split data will replace original data
        Const DestinationOffset As Long = 1
        
        MaxChars = Application.InputBox("Maximum number of characters per line?", Type:=1)
        If MaxChars <= 0 Then Exit Sub
        On Error GoTo NoCellsSelected
        Set Source = Application.InputBox("Select cells to process:", Type:=8)
        On Error GoTo 0
        For Each CellWithText In Source
            If Len(CellWithText.Value) Then
                vLine = Split(CellWithText.Value, Chr(10))
                SplitText = ""
                For i = 0 To UBound(vLine)
                    Text = vLine(i)
                    Do While Len(Text) > MaxChars
                        TextMax = Left(Text, MaxChars + 1)
                        If Right(TextMax, 1) = " " Then
                            SplitText = SplitText & RTrim(TextMax) & vbLf
                            Text = Mid(Text, MaxChars + 2)
                        Else
                            Space = InStrRev(TextMax, " ")
                            If Space = 0 Then
                                SplitText = SplitText & Left(Text, MaxChars) & vbLf
                                Text = Mid(Text, MaxChars + 1)
                            Else
                                SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
                                Text = Mid(Text, Space + 1)
                            End If
                        End If
                    Loop
                    SplitText = SplitText & Text & Chr(10)
                Next
                CellWithText.Offset(, DestinationOffset).Value = IIf(Right(SplitText, 1) = Chr(10), Left(SplitText, Len(SplitText) - 1), SplitText)
            End If
        Next
        Exit Sub
    NoCellsSelected:
    End Sub
    Last edited by Admin; 11-19-2014 at 03:52 PM.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Replies: 6
    Last Post: 06-01-2013, 03:24 PM
  2. Remove Special Characters From Text Or Remove Numbers From Text
    By Excel Fox in forum Excel and VBA Tips and Tricks
    Replies: 5
    Last Post: 05-31-2013, 04:43 PM
  3. Extract Certain Characters From A Text String
    By bobkap in forum Excel Help
    Replies: 5
    Last Post: 05-24-2013, 06:25 AM
  4. Replies: 10
    Last Post: 12-10-2012, 11:28 PM
  5. Replies: 6
    Last Post: 09-26-2011, 07:39 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •