splitting text after previous space

synergy16

Active Member
Joined
Mar 17, 2016
Messages
420
Office Version
  1. 365
Platform
  1. Windows
good afternoon all.

i have a vba program that populates text/list boxes on a form, based on a users request in the form. it reads off a excel sheet that has delivery information for fedex shipments. the cells that contain the delivery "street address" are giving me an issue because they can contain a lot of text at times. so i have 2 text boxes for the address and what i want to do is if the text is over 20 characters long, stop at the first space BEFORE the text counter hit 20 and push the rest of the address (including the word that made the counter go over 20) to the second box. obviously i want to do this so words and/or numbers arent split in the middle. so what i have is>:

Code:
  If Len(Cells(rowTr, 12)) > 20 ThenaddressTB.Text = Left(Cells(rowTr, 12), 20)
End If

this will obviously only include the first 20 characters in the first textbox, but how do i also include the functionality i mentioned above?
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Untested. If it does what you want you can adapt it to your text box code. Assumes the input text is in cell A1 of the active sheet and divides the text string into a first part of no more than 20 characters with no truncation of a word, and a last part which is the balance of the input string.
Code:
Sub First20()
'Assume input string is in cell A1 - change to suit
Dim FirstPart As String, LastPart As String

FirstPart = Trim(Mid([A1], 1, 20))
LastPart = Trim(Mid([A1], Len(FirstPart) + 1, Len([A1]) - Len(FirstPart)))
MsgBox "FirstPart is: " & FirstPart & vbNewLine & "LastPart is: " & LastPart
[A2] = FirstPart
[A3] = LastPart
End Sub
 
Upvote 0
Untested. If it does what you want you can adapt it to your text box code. Assumes the input text is in cell A1 of the active sheet and divides the text string into a first part of no more than 20 characters with no truncation of a word, and a last part which is the balance of the input string.
Code:
Sub First20()
'Assume input string is in cell A1 - change to suit
Dim FirstPart As String, LastPart As String

FirstPart = Trim(Mid([A1], 1, 20))
LastPart = Trim(Mid([A1], Len(FirstPart) + 1, Len([A1]) - Len(FirstPart)))
MsgBox "FirstPart is: " & FirstPart & vbNewLine & "LastPart is: " & LastPart
[A2] = FirstPart
[A3] = LastPart
End Sub
Don't know what I was thinking when I posted this in a hurry to keep an appointment, or maybe I wasn't thinking at all.:mad:

In any case, here's a revision that I hope comes closer to a solution. Assumes your input text is in cell A1 and consists of "words" separated by spaces.The output is two sub-strings: FirstPart and LastPart that are written to cells A2 and A3, respectively.
Code:
Sub First20()
'Assume input string is in cell A1 with space delimiters between words
Dim V As Variant, lngth As Long, i As Long, j As Long
Dim FirstPart As String, LastPart As String
V = Split([A1], " ")
FirstPart = V(LBound(V))
lngth = Len(V(LBound(V)))
For i = LBound(V) + 1 To UBound(V)
    lngth = lngth + Len(V(i)) + 1
    If lngth > 20 Then
        For j = LBound(V) + 1 To i - 1
            FirstPart = FirstPart & " " & V(j)
        Next j
        If FirstPart <> V(LBound(V)) Then Exit For
    End If
Next i
If FirstPart = V(LBound(V)) Then
    FirstPart = Trim([A1])
    LastPart = ""
    GoTo Output
End If
LastPart = Trim(Mid([A1], Len(FirstPart) + 1, Len([A1]) - Len(FirstPart)))
Output: MsgBox "FirstPart is: " & FirstPart & vbNewLine & "LastPart is: " & LastPart
[A2] = FirstPart
[A3] = LastPart
End Sub
 
Upvote 0
Here are two functions, the first returns the first 20 characters or less ending on a space, the second returns the remainder of the text. Both function take the same argument (either a quoted text string, a variable containing text or a cell value). Just assign the output from these functions to the appropriate TextBox.
Code:
Function First20(Text As Variant) As String
  Dim SpaceChar As Long, TextMax As String
  Do
    TextMax = Left(Text, 21)
    If Right(TextMax, 1) = " " Then
      First20 = RTrim(TextMax)
      Exit Do
    Else
      SpaceChar = InStrRev(TextMax, " ")
      If SpaceChar = 0 Then
        First20 = Left(Text, 20)
      Else
        First20 = Left(TextMax, SpaceChar - 1)
      End If
      Exit Do
    End If
  Loop
End Function

Function Second20(Text As Variant) As String
  Second20 = Trim(Mid(Text, Len(First20(Text)) + 1))
End Function
 
Upvote 0
Try this, Change the data in red for your information

Code:
Private Sub CommandButton1_Click()
    n = [COLOR=#ff0000]20[/COLOR]
    a = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]").Range("[COLOR=#ff0000]B7[/COLOR]").Value & Space(n + 1)
[COLOR=#008000]    If Mid(a, n + 1, 1) <> " " Then n = InStrRev(Left(a, n + 1), " ")[/COLOR]
    [COLOR=#ff0000]TextBox1[/COLOR].Value = WorksheetFunction.Trim(Left(a, n))
    [COLOR=#ff0000]TextBox2[/COLOR].Value = WorksheetFunction.Trim(Mid(a, n + 1))
End Sub

Only if there is a word of more than 20 characters or if the words are not separated by " ", then use this line:

Code:
[COLOR=#0000ff]If Mid(a, n + 1, 1) <> " " Then n = IIf(InStr(1, Left(a, n + 1), " ") > 0, InStrRev(Left(a, n + 1), " "), n)[/COLOR]
 
Upvote 0
your solution worked perfectly Joe, thank you
 
Last edited:
Upvote 0
your solution worked perfectly Joe, thank you

Only Joe's solution has a couple of details, if cell A1 is blank it ends with an error.
And if the cell has a word with more than 20 characters, it does not make a separation, the latter was not specified, but it does not solve it either.

By the way the solution you wanted in textbox.
:)
 
Last edited:
Upvote 0
Only Joe's solution has a couple of details, if cell A1 is blank it ends with an error.
And if the cell has a word with more than 20 characters, it does not make a separation, the latter was not specified, but it does not solve it either.

By the way the solution you wanted in textbox.
:)

thanks Dante. i put in a fix for the NULL issue and coded your solution in to my program for the 20 char issue
 
Upvote 0
thanks Dante. i put in a fix for the NULL issue and coded your solution in to my program for the 20 char issue

My proposal has no problems with the blank data. It could look like this:

Code:
    n = 20
    a = Cells(rowTr, 12).Value & Space(n + 1)
    If Mid(a, n + 1, 1) <> " " Then n = InStrRev(Left(a, n + 1), " ")
    [COLOR=#0000ff]ThenaddressTB[/COLOR].Value = WorksheetFunction.Trim(Left(a, n))
    [COLOR=#ff0000]ThenaddressTB_2[/COLOR].Value = WorksheetFunction.Trim(Mid(a, n + 1))
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,264
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top