split string after x characters? 5

[ale1981]

I would like to split a string if it is over x characters long after x amount of characters, is this possible? for example;

string = "this is one long line of text"

string1 = "this is one long line"
string2 = "of text"

the split can not split in the middle of words.

 

[xlbo]

how many items do you want it split into?

What are the rules for if your no. of characters DOES happen in the middle of the word? would you want to split prior to that word or after that word?

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[ale1981]

Hi Geoff,

The maximum amount if items i would like a string split into is 3. If the no. of characters does happen in the middle of the word i would like the split to occur before the word.

I have searched everywhere for a way of doing this in VBA but can not find one!

 

[strongm]

Can we establish why you want or need to do this split, as it may suggest an appropriate solution (e.g. if you are trying to split text to fit into a textbox, Windows has a built-in method for doing this)

 

[ale1981]

Ok, i have an application where a message is inserted into the database via a web interface, the maximum characters for the database field is 255 characters.

I want to display the message (via a message box) in the application. If i pass the whole 255 characters to a message box it does not appear nicely. What i want to do is split the message over 3 lines of a message box, so the most characters one single line can have is 85.

for example;

MsgBox string1 + vbCrlf + string2 + vbCrlf + string3

 

[MakeItSo]

OK:

1) Split the message into words like this:

Dim msg as String, dbmsg as String, wds, buf as string
'...
dbmsg=rs("Message") 'Your return value as queried from the db
wds=split(dbmsg, " ")

This splits all words separated by spaces.
Now join words back again, inserting a vbnewline every time you reach a max of 85 characters:

'...
for i=0 to ubound(wds)
  buf=buf & wds(i) & " "
  if len(buf)<85 then
    msg=msg & wds(i)
  else
    msg=msg & vbnewline
    buf=""  'reset string buffer
  end if
next i

Warning: this code is untested. Should work though.
;-)

Cheers,
MiS

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[ale1981]

Hi MakeItSo,

It kind of works, but when the message is displayed the words have no spaces between them!!

 

[HarleyQuinn]

Put a space in the concatenation of msg & wds(i)...

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[ale1981]

Ok i was wrong!

That fixed the no space issue but I have noticed that the word before the new line is inserted is being cut!

example if i change the length from 85 to 12;

"This is a test line message"

because "test" and "message" is in the middle of 12 it gets cut out and doesnt get displayed...

This is a
line

 

[SkipVought]

Hi,

Here's some code I posted recently for a similar question.

Function HangingIndent(rng As Range, iInd As Integer)
    Dim iWid As Integer, a, sOUT As String, idx As Integer
    With rng
        iWid = .ColumnWidth
        a = Split(.Value, " ")
        For idx = 0 To UBound(a)
            If Len(sOUT & " " & a(idx)) > iWid Then
                HangingIndent = HangingIndent & sOUT & vbLf
                sOUT = String(iInd, " ") & a(idx)
            Else
                sOUT = sOUT & " " & a(idx)
            End If
        Next
        HangingIndent = HangingIndent & sOUT
    End With
End Function

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[MakeItSo]

Ah yes, I see.
Untested, as I said; my fault.

for i=0 to ubound(wds)
  buf=buf & wds(i) & " "
  if len(buf)<85 then
    msg=msg & wds(i)[b] & " "[/b]
  else
    msg=msg & vbnewline[b] & wds(i)[/b]
    buf=""  'reset string buffer
  end if
next i

[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[ale1981]

Thanks MakeItSo,

forgot another & " ", but this works great...

for i=0 to ubound(wds)
  buf=buf & wds(i) & " "
  if len(buf)<85 then
    msg=msg & wds(i) & " "
  else
    msg=msg & vbnewline & wds(i) & " "
    buf=""  'reset string buffer
  end if
next i

Thanks again.

 

[strongm]

Ok, so, yes, 'intelligent' line wrapping ...

Windows can do this for you - trouble is that the method I use requires an edit control with an hWnd - and the VBA Form's textboxes don't have one ...

So, I need a quick think. I shall return with a possible solution.

 

[MakeItSo]

forgot another & " "

Yargh! Never should do coding in between jobs...

Glad you got it sorted!


[navy]"We had to turn off that service to comply with the CDA Bill."[/navy]
- The Bastard Operator From Hell

 

[TonyJollans]

Not properly tested, but what about ...

[blue]Function PrettyString(ByVal StringIn As String, _
                      Optional LineLen As Long = 85) As String

    Dim BreakAt As Long
    BreakAt = 0

    Do
        BreakAt = InStrRev(StringIn, Space(1), LineLen + BreakAt)
        Mid(StringIn, BreakAt) = vbCr
    Loop While LineLen + BreakAt < Len(StringIn)
    
    PrettyString = StringIn

End Function
[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website

 

[ale1981]

Hi Tony

Just tested your function and it seems to work perfectly also.

Strange that I could not find a function to do this after hours of searching on google and I have 2 working within hours of posting on here!

Many Thanks!

 

[ale1981]

For anybody else wanting to use this, the function caused an error if the StringIn was less than LineLen so I had to add a little IF clause;

Function SplitString(ByVal StringIn As String, _
                      Optional LineLen As Long = 85) As String

    Dim BreakAt As Long
    BreakAt = 0
    If Len(StringIn) > LineLen Then
        Do
            BreakAt = InStrRev(StringIn, Space(1), LineLen + BreakAt)
            Mid(StringIn, BreakAt) = vbCr
        Loop While LineLen + BreakAt < Len(StringIn)
    End If
    
    SplitString = StringIn

End Function

 

[HarleyQuinn]

Just for the hell of it...

Function SplitString(ByVal StringIn As String, _
                      Optional LineLen As Long = 85) As String
Dim re As Object
Dim m As Variant

Set re = CreateObject("VBScript.RegExp")

With re
    .Global = True
    .MultiLine = True
    .IgnoreCase = True
    .Pattern = ".{1," & LineLen & "}( |$)"
    For Each m In .Execute(StringIn)
        SplitString = SplitString & m & vbCrLf
    Next m
    
End With

Set re = Nothing

End Function

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http://lessthandot.com

 

[ale1981]

3 great ways to do the same job!

I guess the only question is, which is the quickest?!

 

[strongm]

>3 great ways to do the same job!

Um, under certain circumstances ...