splitting text after previous space

[synergy16]

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>:

  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?

 

[JoeMo]

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.

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

 

[JoeMo]

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.

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.

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.

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

 

[Rick Rothstein]

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.

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

 

[DanteAmor]

Try this, Change the data in red for your information

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:

[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]

 

[synergy16]

your solution worked perfectly Joe, thank you

 

[DanteAmor]

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.

 

[synergy16]

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

 

[DanteAmor]

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:

    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))