Break up text in a single cell into separate cells with limited text length

[SUNNY ISLAND]

I have the following text in cell A1

HUNDRED TREES, 87 WEST COASTAL DRIVE, #12-10, HONG KONG 128015

I would like to break up the text to cells A2 and A3 and each cell can take only text length up to 40

Can this be done via WS formula instead of VBA?

THANKS

 

[István Hirsch]

István

- For me it returns #VALUE once it runs out of text to evaluate. eg A6 & below for "HUNDRED TREES AREA, 87 WEST COASTAL DRIVE, #12-10, HONG KONG 128015, HONG KONG"

- Do you see a circumstance where my considerably shorter & non-array-entered formula from the bottom part of post #17 would not work?

I am sure your formula in post #17 works fine and has a lot of advantages (simpler, better-built, not-array etc.) compared to my formula and must be preferred by the asker. As for my formula, I just do not want to leave it incorrect, so thanks for the note.

 

[Peter_SSs]

As for my formula, I just do not want to leave it incorrect, so thanks for the note.

OK, fair enough. I understand that sentiment!

 

[István Hirsch]

@ Sunny Island

Peter’s formula in post #17 works fine. Please ignore my formulae in post #15, #18 and #19.

 

[Perpa]

Assuming the original text does not include and double, triple etc spaces, then try ..
In A2: =LEFT(A1,40-LEN(TRIM(RIGHT(SUBSTITUTE(LEFT(A1,41)," ",REPT(" ",100)),100))))
In A3 and copy down: =IF(A2="","",TRIM(LEFT(MID(A$1,FIND(A2,A$1)+LEN(A2)+1,LEN(A$1)),40-LEN(TRIM(RIGHT(SUBSTITUTE(LEFT(MID(A$1,FIND(A2,A$1)+LEN(A2)+1,LEN(A$1)),41)," ",REPT(" ",100)),100))))))

Peter_SSs,
Thank you for the two formulae. I had worked on doing something similar using VBA but was never quite satisfied.
Using your formulae I have completed the task. Below is the code I developed which uses the selected cell
with the string, then creates text in as many cells as required below that. In my case I used a 125-character limit and
converted each line to text, no formulae. Thank you again!
Perpa

Sub CharactersPerLine_125()
Dim a As Range
Dim rw, rw1, LastRow As Long
Dim col As Integer
Dim colL As String
Dim numLines As Integer

rw = ActiveCell.Row
rw1 = ActiveCell.Row
col = ActiveCell.Column
colL = ColLetter(col)

'**********************
'A2 =LEFT(A1,125-LEN(TRIM(RIGHT(SUBSTITUTE(LEFT(A1,126)," ",REPT(" ",100)),100))))
rw = rw + 1
ActiveSheet.Cells(rw, col).Formula = "=LEFT(" & colL & rw1 & ",125-LEN(TRIM(RIGHT(SUBSTITUTE(LEFT(" & colL & rw1 & ",126),"" "",REPT("" "",100)),100))))"

'**********************
'A3 and copy down:  =IF(A2="","",TRIM(LEFT(MID(A$1,FIND(A2,A$1)+LEN(A2)+1,LEN(A$1)),125-LEN(TRIM(RIGHT(SUBSTITUTE(LEFT(MID(A$1,FIND(A2,A$1)+LEN(A2)+1,LEN(A$1)),126)," ",REPT(" ",100)),100))))))
rw = rw + 1
numLines = Application.RoundUp(Len(Cells(rw1, col)) / 125, 0) 'Number of LINES that will be created
LastRow = rw + numLines - 1
For rw = rw To LastRow
    ActiveSheet.Cells(rw, col).Formula = "=IF(" & colL & rw - 1 & "="""","""",TRIM(LEFT(MID(" & colL & rw1 & ",FIND(" & colL & rw - 1 & "," & colL & rw1 & ")+LEN(" & colL & rw - 1 & ")+1,LEN(" & colL & rw1 & ")),125-LEN(TRIM(RIGHT(SUBSTITUTE(LEFT(MID(" & colL & rw1 & ",FIND(" & colL & rw - 1 & "," & colL & rw1 & ")+LEN(" & colL & rw - 1 & ")+1,LEN(" & colL & rw1 & ")),126),"" "",REPT("" "",100)),100))))))"
Next rw

Range(colL & rw1 + 1, colL & rw).Copy
Range(colL & rw1).PasteSpecial (xlValues)
Cells(rw - 2, col).Select
End Sub

Function ColLetter(iCol As Integer) As String
    'iCol is the column NUMBER you enter to GET the column LETTER
  ColLetter = Cells(1, iCol).Address(False, False)
  ColLetter = Left(ColLetter, Len(ColLetter) - 1)
End Function

 

[Peter_SSs]

Peter_SSs,
Thank you for the two formulae. I had worked on doing something similar using VBA but was never quite satisfied.
Using your formulae I have completed the task. Below is the code I developed which uses the selected cell ..

Great that you were able to adapt the formulas for vba to do the job.
If you are interested, here is a much simpler vba code to do the same job.

My code writes the result below the active cell, whereas yours replaces the active cell with the first line of the result.
If you do want to start the results in the active cell, then just remove the red text in my code.

If you want a different number of (maximum) characters per line, just edit the "Const" line in the code

Sub BreakItUp()
  Dim s As String
  Dim k As Long
  Dim result
  
  Const CharsPerLine As Long = 125     '<-Change to suit
  
  s = ActiveCell.Text
  ReDim result(1 To Len(s), 1 To 1)
  Do Until Len(s) = 0
    k = k + 1
    result(k, 1) = RTrim(Left(s, InStrRev(s & Space(CharsPerLine), " ", CharsPerLine + 1) - 1))
    s = Mid(s, Len(result(k, 1)) + 2)
  Loop
  ActiveCell.Offset(1).Resize(k).Value = result
End Sub

 

[Perpa]

Great that you were able to adapt the formulas for vba to do the job.
If you are interested, here is a much simpler vba code to do the same job.

My code writes the result below the active cell, whereas yours replaces the active cell with the first line of the result.
If you do want to start the results in the active cell, then just remove the red text in my code.

If you want a different number of (maximum) characters per line, just edit the "Const" line in the code

Sub BreakItUp()
  Dim s As String
  Dim k As Long
  Dim result
  
  Const CharsPerLine As Long = 125     '<-Change to suit
  
  s = ActiveCell.Text
  ReDim result(1 To Len(s), 1 To 1)
  Do Until Len(s) = 0
    k = k + 1
    result(k, 1) = RTrim(Left(s, InStrRev(s & Space(CharsPerLine), " ", CharsPerLine + 1) - 1))
    s = Mid(s, Len(result(k, 1)) + 2)
  Loop
  ActiveCell.Offset(1).Resize(k).Value = result
End Sub

Peter_SSs,
Much shorter code, just a little beyond my coding abilities at this time.
Thank you for the feedback, and also thank you for what you do for this forum.
Perpa