Split Text In To Segments Of Upto X Characters And At The Space Between Words

[Excel Fox]

Try this

Sub CallSpliter()

     SplitText Worksheets("Sheet1").Range("A1:A100")
    
End Sub
Sub SplitText(ByRef rngSource As Range)


    Const clngSplitLen As Long = 50
    Const clngMaxSplits As Long = 99
    Dim strText As String
    Dim strBreakPoints(1 To clngMaxSplits) As String
    Dim lngSplitsCounter As Long
    Dim lngIndex As Long
    Dim rngCell As Range
    
    For Each rngCell In rngSource
        strText = Trim(rngCell.Value)
        strBreakPoints(1) = strText
        Do While Len(strText) > clngSplitLen
            lngSplitsCounter = lngSplitsCounter + 1
            If Mid(strText, clngSplitLen + 1, 1) = " " Then
                strBreakPoints(lngSplitsCounter) = Left(strText, clngSplitLen)
                strText = Trim(Mid(strText, clngSplitLen + 1))
            Else
                lngIndex = InStrRev(Left(strText, clngSplitLen), " ")
                strBreakPoints(lngSplitsCounter) = Trim(Left(strText, lngIndex))
                strText = Trim(Mid(strText, lngIndex + 1))
                strBreakPoints(lngSplitsCounter + 1) = strText
            End If
        Loop
        rngCell.Offset(, 1).Resize(, lngSplitsCounter + 1).Value = strBreakPoints
        strText = vbNullString
        lngSplitsCounter = Empty
        Erase strBreakPoints
    Next rngCell
    Set rngCell = Nothing
    
End Sub