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-questions/1114278-insert-line-break-after-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.