cutting text to 255 characters (but not chopping words in half)

[nayone]

Hi there

I have a workbook that emails itself but text over 255 characters gets truncated, so to get round this I have some code that chops up text entered by a user and puts it into cells below it
Range("A3").Value = Mid(Sheet1.Cells(1, 1), 511, 255)
Range("A2").Value = Mid(Sheet1.Cells(1, 1), 256, 255)
Range("A1").Value = Mid(Sheet1.Cells(1, 1), 1, 255)


Now this works fine but obviously chops up the words, now to smarten this up I have another but of code that takes out the words individually, now my idea was to take out blocks of 255 or less and paste them below the input text but am having trouble
any ideas if this is the right route to go down?

Sub SplitWords()

txtstring = Cells(1, 1)


For i = 1 To Len(txtstring)

If Mid(txtstring, i, 1) = " " Then z = z + 1
Next i
ReDim y(z + 3)

For i = 1 To Len(txtstring)

If Mid(Tstring, i, 1) <> " " Then
x = x & Mid(txtstring, i, 1)
End If

If Mid(txtstring, i, 1) = " " Then
y(c) = x
c = c + 1
x = ""
End If

Next i

y(z) = x

For i = 0 To UBound

Cells(1, 1).Offset(i + 1, 0).Value = y(i)
Next i

End Sub

 

[nayone]

solved by a colleage in case anyone is interested :

Sub TwoFiveFivePerCell()
Dim strText As String
Dim c As Long, i As Long
Dim Found As Boolean
strText = Cells(1, 1)
'set c as the first row where you want to place new text
c = 2
While Len(strText) > 255
Select Case Mid(strText, 256, 1)
Case " "
Cells(c, 1) = Left(strText, 255)
Case Else
i = 1
Found = False
Do
If Mid(strText, 256 - i, 1) = " " Then
Cells(c, 1) = Left(strText, 255 - i)
Found = True
End If
i = i + 1
Loop Until Found
End Select
strText = Right(strText, Len(strText) - Len(Cells(c, 1)))
c = c + 1
Wend
Cells(c, 1) = strText
End Sub