PDA

View Full Version : Split Cells help



MontySharpei
06-30-2008, 01:50 PM
Hello.

The attached file contains a macro that when ran, will split the text up into the cell below the active cell if the length of the sentence is greater than the cell width. and will continue to do so until the length is less than the cell width. I have been trying for hours to modify the code so that instead of just inserting the text into the cell below the active cell, a new row is added first. But I cannot get it to work. can anyone assist please ....

Bob Phillips
06-30-2008, 03:02 PM
MoveRight screws up, what is supposed to happen?



Sub SplitText()
Dim MyText As String
Dim WrapLength As Long, StrLen As Long, j As Long
Dim SplitRatio As Double
Dim NextCell As Range

'SplitRatio = 0.22 'Set own value in place of InputBox if desired
SplitRatio = InputBox("Enter ratio", "Cell width/Characters", Ratio)

Application.EnableEvents = False

'Return to previous cell
If Application.MoveAfterReturnDirection = xlToRight Then
Set NextCell = ActiveCell
MyText = ActiveCell.Offset(0, -1).Value
ActiveCell.Offset(0, -1).Value = ""
Else
MyText = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(-1, 0).Value = ""
End If
WrapLength = Int(ActiveCell.Width) * SplitRatio
'Analyse text for space preceding cell width and split text
Do
StrLen = Len(MyText)
If StrLen > WrapLength Then

For j = WrapLength To 0 Step -1

If j = 0 Then Exit For
If Mid(MyText, j, 1) = " " Then

ActiveCell.Value = Left(MyText, j)
MyText = Right(MyText, StrLen - j)
Exit For
End If
Next
ActiveCell.Offset(1, 0).Select
End If
Loop Until Len(MyText) <= WrapLength
ActiveCell.Offset(1, 0).Select
'Move to right based on MoveAfterEnter
If Not NextCell Is Nothing Then NextCell.Select

Application.EnableEvents = True
End Sub

MontySharpei
07-01-2008, 08:03 AM
Hi

I want the text to be split into however number of lines is required but would like the code to insert lines first...

Bob Phillips
07-01-2008, 08:43 AM
And ...

mdmackillop
07-01-2008, 10:51 AM
Sub SplitText()
Dim MyText As String
Dim WrapLength As Long, StrLen As Long, j As Long
Dim SplitRatio As Double
Dim NextCell As Range

'SplitRatio = 0.22 'Set own value in place of InputBox if desired
On Error Resume Next
SplitRatio = InputBox("Enter ratio", "Cell width/Characters", Ratio)
If SplitRatio = 0 Then Exit Sub
Application.EnableEvents = False

'Return to previous cell
If Application.MoveAfterReturnDirection = xlToRight Then
Set NextCell = ActiveCell
MyText = ActiveCell.Offset(0, -1).Value
ActiveCell.Offset(0, -1).Value = ""
Else
MyText = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(-1, 0).Value = ""
End If
WrapLength = Int(ActiveCell.Width) * SplitRatio
'Analyse text for space preceding cell width and split text
Do
StrLen = Len(MyText)
If StrLen > WrapLength Then

For j = WrapLength To 0 Step -1

If j = 0 Then Exit For
If Mid(MyText, j, 1) = " " Then
k = k + 1
ActiveCell.Offset(k - 1).EntireRow.Insert
ActiveCell.Offset(k - 1) = Left(MyText, j)
MyText = Right(MyText, StrLen - j)
Exit For
End If
Next
End If
Loop Until Len(MyText) <= WrapLength
'Move to right based on MoveAfterEnter
If Not NextCell Is Nothing Then NextCell.Select

Application.EnableEvents = True
End Sub

MontySharpei
07-01-2008, 11:12 AM
Once again thankyou ! works perfectly !!

MontySharpei
07-09-2008, 11:48 AM
arrrrggggggghhhhh ! spoke too soon. Ok at home where I have excel2007 the above code works perfectly and im happy. However i go to work and try to use the above and it crashes !!! work uses excel2000. Can anyone offer a fix to my problem ????

mdmackillop
07-09-2008, 12:10 PM
I use the code on 2000 at work. Exactly where does it crash?

MontySharpei
07-09-2008, 12:31 PM
when i run the code at work the text appears in the cell to the right then completely freezes up!!!

mdmackillop
07-09-2008, 12:33 PM
You need to step though the code to find where it stops. Posting a workbook might assist.