Insert a line break after word wrap

[av8tordude]

I have a multi-line textbox I want to insert a line break after word-wraps to a new line. Can someone help with a vba code that can do this.

Thank you kindly

I posted this in another forum..

​https://www.mrexcel.com/forum/excel-...word-wrap.html

[paulked]

    TextBox1 = "The quick brown fox jumps over the lazy dog." & Chr(10) & "Here we go again!"

[av8tordude]

Hi Paul,

Can you help me out with this code. I placed this code in the textbox1 change event, but when I use a command button to place the string in a cell, it still shows 1 string. I event tried putting the code in the command button, but still 1 string. It doesn't show two lines

[paulked]

A text box is one string, no matter what breaks, carriage returns etc are in it. What exactly are you trying to do?

[av8tordude]

If I type the below string in a textbox and the string is word-wrapped from word "lazy", I want to enter the string in a cell exactly like below. Which means, it needs a line break after the word "lazy". I can manually press shift-enter but i would like to do this automatically or place the string in the cell exactly like it is displayed in the textbox.

The quick brown fox jumps over the lazy
dog."Here we go again!"

[Artik]

In attachment only leaven to bread. I don't know any other method than examining the text in the auxiliary field. But I do not exclude that another way exists.

Artik

[paulked]

Private Sub CommandButton1_Click()
    Sheet1.[a1] = TextBox1.Text
End Sub


Private Sub UserForm_Activate()
    TextBox1 = "The quick brown fox jumps over the lazy" & Chr(10) & "dog.  Here we go again!"
End Sub

That works perfectly well for me. A1 contains

The quick brown fox jumps over the lazy
dog. Here we go again!

[av8tordude]

Artik....this is exactly what I'm looking for. I'll examine the code to fit my needs. Thank you very much

[av8tordude]

When there is 1 line string, it errors. how can I alter the code to allow for entering string that doesn't wrap also

ReDim Preserve varResult(1 To k)

Private Sub CommandButton1_Click()
    Dim varTxt1     As Variant
    Dim i           As Long
    Dim k           As Long
    Dim varResult   As Variant
    Dim sngWdth     As Single
    Dim sngHght     As Single
    Dim lLastSpacePos As Long
    Dim strTmp      As String


    varTxt1 = Split(Me.TextBox1.Text)
    sngWdth = Me.TextBox1.Width
    Me.TextBox2.Width = sngWdth
    sngHght = Me.TextBox2.Height
    Me.TextBox2.MultiLine = True


    Do
        Me.TextBox2.Value = Me.TextBox2.Value & varTxt1(i) & " "
        Me.TextBox2.AutoSize = True


        If Me.TextBox2.Height > sngHght Then


            strTmp = Left(Me.TextBox2.Value, Len(Me.TextBox2.Value) - 1)
            lLastSpacePos = InStrRev(strTmp, " ")
            strTmp = Left(strTmp, lLastSpacePos - 1)


            If k = 0 Then
                k = k + 1
                ReDim varResult(1 To 1)
            Else
                k = k + 1
                ReDim Preserve varResult(1 To k)
            End If


            varResult(k) = strTmp
            Me.TextBox2.Value = Mid(Me.TextBox2.Value, Len(strTmp) + 2)


        End If


        i = i + 1
        Me.TextBox2.Width = sngWdth
        Me.TextBox2.Height = sngHght
        Me.TextBox2.AutoSize = False


    Loop Until i > UBound(varTxt1)


    If Len(Me.TextBox2.Value) > 0 Then
        k = k + 1
        ReDim Preserve varResult(1 To k)
        varResult(k) = Trim(Me.TextBox2.Value)
        Me.TextBox2.Value = vbNullString
    End If




    varResult = Join(varResult, vbLf)


    Range("A1") = varResult

[Artik]

Below, it is extinguishing a fire, not a decent solution
Change:

(...)
    Loop Until i > UBound(varTxt1)


    If Len(Me.TextBox2.Value) > 0 Then
      
      If k = 0 Then
        k = k + 1
        ReDim varResult(1 To 1)
      Else
        k = k + 1
        ReDim Preserve varResult(1 To k)
      End If
      
        varResult(k) = Trim(Me.TextBox2.Value)
        Me.TextBox2.Value = vbNullString
    End If
(...)

Artik

[av8tordude]

One last request...If the textbox Enterkeybehavior is set to true, can you adapt the code to allow this?

[Kenneth Hobs]

FWIW, I used Word to do it. It takes some math to make it fit in a cell just right. That can change if fonts change.

'https://www.mrexcel.com/forum/excel-questions/1022360-fitting-text-listbox.htmlSub Test_LinesToArr()
  Dim s As String, a
  s = "Fourscore and seven years ago our " & _
      "fathers brought forth on this continent a new nation"
  a = LinesToArr(s, Sheet2.tbML.Width - 40)
  'MsgBox Join(a, vbLf)
  Sheet2.[A1] = Join(a, vbLf)
End Sub


'https://docs.microsoft.com/en-us/office/troubleshoot/excel/determine-column-widths, 10=75 pixels
'textbox width is in points.
Function LinesToArr(s As String, dPoints As Double, _
  Optional wFile As String = "")
  Dim a(), strLine As String, i As Long, L As Long
  'Tools > References > Microsoft Word xx.0 Object Library
  Dim wdApp As Word.Application, myDoc As Word.Document
  Dim wClose As Boolean
  
  If wFile = "" Then wFile = ThisWorkbook.Path & "\LinesToArray.docm"
  
  'Tell user what file is missing and exit.
  If Dir(wFile) = "" Then
    MsgBox "File does not exist." & vbLf & wFile, _
      vbCritical, "Exit - Missing LinesToArray File"
  End If
  
  On Error Resume Next
  Set wdApp = GetObject(, "Word.Application")
  If Err.Number <> 0 Then
      Set wdApp = CreateObject("Word.Application")
      wClose = True
  End If
  On Error GoTo 0
  'On Error GoTo errorHandler
  
  With wdApp
    .Application.DisplayAlerts = wdAlertsNone
    
    'Open form file and associate data file
    Set myDoc = wdApp.Documents.Open(wFile, Visible:=True)
    With myDoc
      .Content = s
      With wdApp.Selection.ParagraphFormat
        .LeftIndent = InchesToPoints(0)
        '9.6 = 1" in LinesToArray.docm
        .RightIndent = InchesToPoints(10.6 - dPoints / 72)
      End With
      L = .BuiltinDocumentProperties("Number of Lines")
    End With
    
    With wdApp.Selection
      .HomeKey Unit:=wdStory
      Do
        .EndKey Unit:=wdLine, Extend:=wdExtend
        ReDim Preserve a(0 To i)
        a(i) = .Text
        .MoveDown Unit:=wdLine, Count:=1
        .HomeKey Unit:=wdLine, Extend:=wdExtend
        .MoveLeft Unit:=wdCharacter, Count:=1
        i = i + 1
      Loop Until i = L
    End With
    
    .Application.DisplayAlerts = wdAlertsAll
    myDoc.Close False
    Set myDoc = Nothing
    If wClose Then Set wdApp = Nothing
  End With
  
    GoTo EndNow
errorHandler:
    MsgBox "Unexpected error: " & Err.Number & vbLf & Err.Description
    
EndNow:
  'Trim trailing chars in last element if it exists.
  s = a(UBound(a))
  'If Right(s, 2) = vbNewLine Then a(UBound(a)) = Left(s, Len(s) - 2)
  If Right(s, 1) = vbCr Then a(UBound(a)) = Left(s, Len(s) - 1)
  LinesToArr = a
End Function

[snb]

Might be sufficient:

Private Sub CommandButton1_Click()
    x = TextBox1.Width \ 4
    
    sn = Split(TextBox1)
    For j = 0 To UBound(sn)
       If Len(c01) + Len(sn(j)) > x Then
          c00 = c00 & vbLf & Trim(c01)
          c01 = sn(j) & " "
       Else
          c01 = c01 & sn(j) & " "
       End If
    Next
    
    MsgBox c00 & vbLf & c01
End Sub

[av8tordude]

Might be sufficient:

Private Sub CommandButton1_Click()
    x = TextBox1.Width \ 4
    
    sn = Split(TextBox1)
    For j = 0 To UBound(sn)
       If Len(c01) + Len(sn(j)) > x Then
          c00 = c00 & vbLf & Trim(c01)
          c01 = sn(j) & " "
       Else
          c01 = c01 & sn(j) & " "
       End If
    Next
    
    MsgBox c00 & vbLf & c01
End Sub

This code works wonderful for me. Only 1 issue I can't seem to fix. The code adds a vbLf before the string.

example

vbLf
My dog name is vbLf
spot. he is a vbLf
boy dog.

[snb]

Private Sub CommandButton1_Click()
  x = TextBox1.Width \ 4
  sn = Split(TextBox1)
    
  For j = 0 To UBound(sn)
    If Len(c01) + Len(sn(j)) > x Then
      c00 = c00 & vbLf & Trim(c01)
      c01 = sn(j) & " "
    Else
      c01 = c01 & sn(j) & " "
    End If
  Next

  MsgBox mid(c00,2) & vbLf & c01
End Sub

[av8tordude]

I would like my textbox to be flexible for the user. Can this code be suited in conjunction with the EnterKeyBehavior set to true

[snb]

I see no relation between 'flexible' and 'EnterKeyBehaviot'.

[Kenneth Hobs]

You will have to explain what flexible means to you. Code is all about logic so if we don't know the rules, it can not be "flexible".

If EnterKeyBehavior is set, so what? Ctrl+Enter key will enter a new line no matter what that is set to if multiline property is true.