Option Explicit 
 
Sub DisplayLongText() 
     'Adds line feed characters as required on cells in selection that are longer than 1024 characters
    Dim cel As Range 
    Dim col As Long 
    For Each cel In Selection 
        AddLineFeeds cel, col 
    Next 
    col = 0 'Force line length dialog to display the next time sub runs
End Sub 
 
Sub AddLineFeeds(cel As Range, col As Long) 
     'Adds line feed characters at end of each line of text. Some experimentation may be required to set number
     'of characters at the wrapping point.
     'Code requires Excel 2000 or later because of Replace and InStrRev functions
    Static lineIncr As Long 
    Dim i As Long, j As Long, pos As Long, StartPos As Long 
    Dim sLeft As String, str As String, sRight As String, sLineFeed As String 
     
    StartPos = 1 'Value should be between 1 and 1022. The first 1022 characters (plus ASCII 160 & line feed)
     'will always fit correctly. The macro will add ASCII 160 space plus line feed characters
     'to each line after character StartPos. You may notice that the beginning section of text
     'uses a different "break" point than the end. If this bothers you, set StartPos=1;
     'it will be reset to the chosen line length later in the sub.
     
    With cel 
        If Len(.Value) <= StartPos Then Exit Sub 
         
         'Remove line feed characters which may have been added previously. These always follow an ASCII 160 space.
        sLineFeed = Chr(160) & Chr(10) 'Code puts an ASCII 160 space before every added line feed character
        str = Replace(.Value, sLineFeed, " ") 
         
         'The maximum permitted number of characters on a line. User-specified up to a limit of 256 characters/line
        If .Column <> col Then 'Use same value as last time if still working in same column
            lineIncr = Application.Min(InputBox(Prompt:="Please specify the desired column width (in characters)", _ 
            Title:="Long Text In Cell Utility", Default:=.ColumnWidth - 1), 256) 
            col = .Column 
            If StartPos < lineIncr Then StartPos = lineIncr 
        End If 
         
        sLeft = Left(str, StartPos) 'Excel has no problem wrapping the first 1024 characters
        pos = InStrRev(sLeft, " ") 'Find right-most space in first 1022 characters
        If pos = 0 Then 'No space found, so force a break after 1022 characters
            sLeft = sLeft & sLineFeed 
            sRight = Mid(str, StartPos + 1) 
        Else 'Put ASCII 160 plus line feed characters in place of this right-most space
            sLeft = Left(str, pos - 1) & sLineFeed 
            sRight = Mid(str, pos + 1) 
        End If 
         
        pos = 1 'Loop through remainder of text, looking for places to put ASCII 160 plus line feed characters
        Do 
            j = InStr(pos, sRight, Chr(10)) 
            If j > 0 And j - pos <= lineIncr Then 
                pos = j + 1 
            Else 
                i = InStrRev(sRight, " ", pos + lineIncr) 'Find right-most space in next lineIncr characters
                If i > pos Then 'Put ASCII 160 plus line feed characters in place of this right-most space
                    sRight = Left(sRight, i - 1) & sLineFeed & Mid(sRight, i + 1) 
                    pos = i + 2 
                Else 'Didn't find a good place to break the line, so force the break in middle of a word
                    sRight = Left(sRight, pos + lineIncr) & sLineFeed & Mid(sRight, pos + lineIncr + 1) 
                    pos = pos + lineIncr + 3 
                     
                     
                     
                End If 
            End If 
            If Len(sRight) - pos < lineIncr Then Exit Do 'Not enough text left for a full line
        Loop 
         
        .Value = sLeft & sRight 'Put the rebuilt string in place of the original
    End With 
End Sub