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)...
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:' 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
Note the comment above the line of code where the DestinationOffset constant is set (the Const statement).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
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).
Reply With Quote
Adjustment
Bookmarks