Remove string after a certain character - excel

Question

i'm trying to move words after the first space from 30th character in a string to the next row(i+1) added and remove those words moved to the next row from the current row(i). The code is giving Run-time error '5': Invalid procedure call or argument error message at Cells(i, 1).Value = Left(Cells(i, 1), InStr(30, Cells(i, 1), " ") - 1) line.
Sub TextLimit_02()
Dim i As Long
Dim CelLen As Long
For i = 1 To 50
CelLen = Len(Cells(i, 1))
If CelLen > 40 Then
Rows(i + 1).Insert
Cells(i + 1, 1).Value = Mid(Cells(i, 1), InStr(30, Cells(i, 1), " ") + 1, Len(Cells(i,
1).Value) - InStr(30, Cells(i, 1), " "))
Cells(i, 1).Value = Left(Cells(i, 1), InStr(30, Cells(i, 1), " ") - 1)
Else
End If
Next i
End Sub

Answer 1

Your code doesn't account for the possibility that in a string longer than 40, there are no spaces after position 30.
Breaking the logic down into steps makes it easy to detect this, and possibly add more code to deal with it
Sub TextLimit_02()
Dim i As Long
Dim CelLen As Long
Dim idx As Long
Dim CellString As String
Dim LeftPart As String
Dim RightPart As String
For i = 1 To 50
CellString = Cells(i, 1).Value2
CelLen = Len(CellString)
If CelLen > 40 Then
idx = InStr(30, CellString, " ")
If idx > 0 Then
Rows(i + 1).Insert
LeftPart = Left$(CellString, idx - 1)
RightPart = Mid$(CellString, idx + 1)
Cells(i, 1) = LeftPart
Cells(i + 1, 1) = RightPart
If idx > 40 Then
' there remains >40 characters in Cells(i, 1)
End If
Else
' No spaces after position 30. Cells(i, 1) remains longer than 40
End If
End If
Next i
End Sub
Note that if you split a lot of strings, your data may end up spanning past row 50. With For i = 1 to 50 you will miss processing some string in that case.

Answer 2

This code should do what you intend. Please test it and let me know what it does wrong.
Sub TextLimit_02()
' 269
Dim Txt As String ' text
Dim Tail As String ' tail end of Txt to be moved
Dim p As Long ' position of character in string
Dim R As Long ' loop counter: rows
Application.ScreenUpdating = False
' start from the end of column A to 2nd row
For R = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
Txt = Trim(Cells(R, "A").Value) ' remove leading/trailing blanks
p = InStr(Mid(Txt, 30), " ")
Tail = Trim(Mid(Txt, p + 30)) ' in case of double space
If Len(Tail) Then ' skip if no Tail
Cells(R, "A").Value = Left(Txt, p + 29)
Rows(R + 1).Insert
Cells(R + 1, "A").Value = Tail
End If
Next R
Application.ScreenUpdating = True
End Sub

Answer 3

Try this code:
Sub WrapText()
Const MIN_CARRY_POS = 30, MAX_LEN = 40, CARRY_SYMBOL = " " 'preferences
Dim cl As Range, txt As String, pos As Long, slice As Long
Application.ScreenUpdating = False
Set cl = ThisWorkbook.Worksheets(1).Range("A1")
Do 'main row loop
txt = RTrim(cl.Text)
Select Case Len(txt)
Case 0: Exit Do
Case Is > MAX_LEN
Do While Len(txt) > MAX_LEN 'a nested loop to process text that needs to be carried over
pos = InStr(MIN_CARRY_POS, txt, CARRY_SYMBOL)
If pos < 1 Then pos = MAX_LEN 'if no CARRY_SYMBOL after MIN_CARRY_POS then cut the string at MAX_LEN
slice = WorksheetFunction.Min(pos, MAX_LEN)
cl.Insert xlDown
cl.Offset(-1).Value = Mid(txt, 1, slice) 'output the head
txt = LTrim(Mid(txt, slice + 1)) 'get the rest of the txt
Loop
cl.Value = txt 'output the rest <= MAX_LEN
End Select
Set cl = cl.Offset(1) 'move to the next row
Loop
Application.ScreenUpdating = True
End Sub
Before
After