counting characters to 50 and adding to new line

[Bill Blackburn]

Hi

Hoping someone can help. I need to be able to paste information into excel and then get excel to read the characters to 50 and then move the other info to another line and do the same command again until it has read all the data and put it in lines of 50.

 

[jaime1964]

Hello Mr. Beucaire, Your 2nd solution works well for an application I am working on. Can you additional functionality such that it does not cut into words. If the 70 count lands between O & O in the word WOOD, the macro would slice the string before WOOD. Mr. Beucaire I thank u very much for your time.
Best regards,
Jaime

 

[jbeaucaire]

Here's a couple new versions that do not cut into words:

1) A1 is the source, pastes into the cells below it:

Sub Split30()
Dim MyVal As String, i As Long, MyArr As Variant, buf As String
MyArr = Split(Range("A1"), " ")

For i = LBound(MyArr) To UBound(MyArr)
    If Len(buf & " " & MyArr(i)) > 30 Then
        Range("A" & Rows.Count).End(xlUp).Offset(1).Value = WorksheetFunction.Trim(buf)
        buf = ""
    End If
    buf = buf & " " & MyArr(i)
    If i = UBound(MyArr) Then Range("A" & Rows.Count).End(xlUp).Offset(1).Value = WorksheetFunction.Trim(buf)
Next i

End Sub

2) The ACTIVECELL is the source, and it inserts blank rows below it so as to not overwrite anything that exists below the activecell:

Sub Split30()
Dim MyVal As String, i As Long, MyArr As Variant, buf As String
MyArr = Split(ActiveCell, " ")

    For i = LBound(MyArr) To UBound(MyArr)
        If Len(buf & " " & MyArr(i)) > 30 Then
            ActiveCell.Offset(1).Select
            ActiveCell.EntireRow.Insert xlShiftDown
            ActiveCell.Value = WorksheetFunction.Trim(buf)
            buf = ""
        End If
        buf = buf & " " & MyArr(i)
    Next i
    ActiveCell.Offset(1).Select
    ActiveCell.EntireRow.Insert xlShiftDown
    ActiveCell.Value = WorksheetFunction.Trim(buf)

End Sub