Split text like line wrap into multi columns

  • Thread starter Thread starter 1scant
  • Start date Start date
1

1scant

I have to split an 80 character text string into two 40 character
fields. But it needs to be done like line wrap, not splitting a word.
I am not too concerned with the second field running over the 40
character.

Can someone help this Excel VBA newbie?

Thx
 
Here is a sub that will do it:
Public Sub FortyCharSplit(InputText As String, OutputCells As Range)
Dim Cell1Text As String, Cell2Text As String, LastSpace As Integer
Cell1Text = Left(InputText, 40)
Cell2Text = Right(InputText, Len(InputText) - 40)
' Test to see if the split is already at a space; if not find one:
If Not ((Mid(InputText, 40, 1)) = " " Or (Mid(InputText, 41, 1) = " ")) Then
' Find the last space in the first cell text:
LastSpace = InStrRev(Cell1Text, " ")
' We have to deal with the (unlikely) chance that there are NO spaces:
If LastSpace <> 0 Then
Cell2Text = Right(Cell1Text, Len(Cell1Text) - LastSpace) & Cell2Text
Cell1Text = Left(Cell1Text, LastSpace)
End If
End If
' clean up any leading or trailing spaces:
OutputCells.Cells(1, 1) = "'" & Trim(Cell1Text)
OutputCells.Cells(1, 2) = "'" & Trim(Cell2Text)
End Sub

The sub is set up so that the first cell will always be <40 characters, even
if it makes the second one > 40; also, if there are no spaces within the
first 41 characters or more (unlikely I hope) then you will end up with a
"forced" split at 40 characters anyway.
 
I have to split an 80 character text string into two 40 character
fields. But it needs to be done like line wrap, not splitting a word.
I am not too concerned with the second field running over the 40
character.

Can someone help this Excel VBA newbie?

Thx
Click to expand...

Easy to do with regular expressions. Download and install Longre's free
morefunc.xll add-in from http://xcell05.free.fr/

Then you can use a VBA routine like this:

========================
Option Explicit
Sub SplitLine()
Dim res(1 To 2) As String
Dim str As String
Dim i As Long

str = Selection.Text

For i = 1 To UBound(res)
res(i) = Run([regex.mid], str, ".{1,39}(\s|$)", i)
Next i

End Sub
======================

This can be adapted for strings up to 255 characters in length. If you have
longer strings, we can use the VBA Reg Expressions routines, but they require
more setup.


--ron
 
Hi there,

Have a go with this. I've changed the cut-off (wrap) to 10 for test
purposes, but you can easily change the two instances of 10 to 40 in the
Function and it should work ok.

I've used the "Mid" string function, although I see "K" has used the "InStr"
function which I think is probably better. Anyway, they both work so use
which ever is best for your situation.

Best regards

John



Sub SplitText()

Dim sTextTest As String
Dim iSplitNumber As Integer
Dim sFirstText As String
Dim sLastText As String

sTextTest = "ABCDE FGH IJ"
iSplitNumber = SplitPoint(sTextTest)
MsgBox ("Test will be split at character number: " & iSplitNumber)
If iSplitNumber <> 0 Then
sFirstText = Left(sTextTest, iSplitNumber)
sLastText = Mid(sTextTest, iSplitNumber + 1)
End If
MsgBox ("'" & sFirstText & "'" & vbCr & "'" & sLastText & "'")

End Sub

Function SplitPoint(ByRef sCompleteText As String) As Integer
'This function is passed a string and returns a number
'identifying the first space behind the tenth character
Dim iSplitIndex As Integer

If Len(sCompleteText) > 10 Then
For i = 10 To 1 Step -1
Debug.Print i, Mid(sCompleteText, i, 1)
If Mid(sCompleteText, i, 1) = " " Then
iSplitIndex = i
Exit For
End If
Next i
End If

SplitPoint = iSplitIndex

End Function
 
Thanks for all the really quick replies. I have been trying the
following, and it works pretty good. When I start it at 40 and the 40th
character is the last (non-blank) character of a word, it puts that word
into the next line. So, I think I can start at 41. If the 41st
character is blank, then I can delete that character so the the second
line starts with a non-blank (if that is the case).

Function SplitAt(inTxt)
SplitAt = InStrRev(inTxt, " ", 41)
End Function


Agin, thx so much for the help.
 
Back
Top