Splitting Text in a Cell to a set lenght

Dave80 · Apr 22nd 2016

Hi,

I'm trying to create a macro that will take the text in a free formatted unlimited cell on one worksheet and convert it into a number of cells on another worksheet with each cell containing no more than 60 characters. This is so that it can then be automatically uploaded into another piece of software that cannot handle wrapping text and has a text box maximum length of 60 characters but can have any number of rows.

I've found various methods to achieve this if all text is in a single line within the original cell but as the original cell is in effect a notes section it may contain carriage returns and I haven't found anything that will cope with that. Also, every option I've found so far splits the cell across several columns where as I need to split them down several rows. I'm aware the destination cell will have to be on a different column or worksheet as otherwise it would overwrite the entry below it but that is fine as the end location for the text is a separate sheet anyway and I'm already utilising a few hidden worksheets for data manipulation before it ends up on the required sheet.

Examples of the sort of text that might be in the cells are:

[TABLE="class: outer_border, width: 500"]

[tr]

[td]

ESD Evaporator Level Transmitter for High High trip

0 - 2150mm of R410A or 0 - 2709mm of H2O
0% correspond at the bottom vessel

[/td]

[/tr]

[/TABLE]

or

[TABLE="class: outer_border, width: 500"]

[tr]

[td]

R410A flow from Economizer Outlet to Evaporator Inlet HMI Isolation Valve Open Indication

[/td]

[/tr]

[/TABLE]

What I need to end up with is

[TABLE="class: grid, width: 500"]

[tr]

[td]

Evaporator Level Transmitter - DP

[/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td]

0 - 2150mm of R410A or 0 - 2709mm of H2O

[/td]

[/tr]

[tr]

[td]

0% correspond at the bottom vessel

[/td]

[/tr]

[/TABLE]
(keeping the line space between the first and second row of text is optional)

or

[TABLE="class: grid, width: 500"]

[tr]

[td]

R410A flow from Economizer Outlet to Evaporator Inlet HMI Isolation

[/td]

[/tr]

[tr]

[td]

Valve Open Indication

[/td]

[/tr]

[/TABLE]

Any suggestions anyone can come up with will be greatly received.

Grimes0332 · Apr 22nd 2016

Re: Splitting Text in a Cell to a set lenght

Existing code, offered without explanation. As you said "I'm trying to create", it can be used as a learning exercise.

Code

Public Sub SplitCell(Source As Excel.Range, Dest As Excel.Range, Optional MaxLen As Integer = 60)


   Dim Original As Variant
   Dim EachLine As Variant
   
   Dim MainLoopCounter As Long
   Dim InnerLoopCounter As Long
   
   Dim Output As String


   If InStr(Source.Text, vbCrLf) < 0 Then
      Original = Split(Source.Text, vbCrLf)
   ElseIf InStr(Source.Text, vbCr) > 0 Then
      Original = Split(Source, vbCr)
   ElseIf InStr(Source.Text, vbLf) > 0 Then
      Original = Split(Source.Text, vbLf)
   Else
      MsgBox "Cannot determine line delimiter.", vbExclamation
      Exit Sub
   End If
   
   For MainLoopCounter = LBound(Original) To UBound(Original)
      
      EachLine = Split(Original(MainLoopCounter), " ")
      
      For InnerLoopCounter = LBound(EachLine) To UBound(EachLine)
      
         If Len(Output) + Len(EachLine(InnerLoopCounter)) > MaxLen Then
            WriteCell Output, Dest
         End If
            
         Output = Output & EachLine(InnerLoopCounter) & " "
    
      Next
      
      WriteCell Output, Dest
      
   Next
   
End Sub


Private Sub WriteCell(Output As String, ByVal Dest As Excel.Range)


   Dim c As Excel.Range
   Dim ws As Excel.Worksheet
   
   Set ws = Dest.Parent
   
   If Dest.Value <> vbNullString Then
      Set Dest = Dest.Parent.Cells(Rows.Count, Dest.Column).End(xlUp).Offset(1)
   End If
   
   ' Needed to precerve blank lines - the Line Feed/Carriage Return
   ' character was 'removed' by the Split function
   If Output = "" Then
      Output = vbCr
   End If
   
   ' TRIM as there's a trailing space
   Dest.Value = Trim(Output)
   Output = ""
   
End Sub

Display More

Call it using the syntax

Code

splitcell Activecell, Sheet2.Range("A1")

Basically you tell it the range (one cell) containing the text, the first cell of the output range and optonally the maximum length of each line. This defaults to 60 so can probably be ignored.

Dave80 · Apr 25th 2016

Re: Splitting Text in a Cell to a set lenght

Cheers for that! I'll have a play with it today and see if I can get it working.

Dave80 · Apr 25th 2016

Re: Splitting Text in a Cell to a set lenght

I've been having a play around with the code above and have hit a slight snag........ I'm sure it's something obvious but I'm struggling to see it. If the cell does not contain a carriage return then the code is ignoring it.

I need to end up with all Descriptions in a single column, potentially with the description split over several rows depending on it's length. Ideally I also need to include a reference to the original row number in the preceding column leaving me with something along the lines of the following:

[TABLE="class: grid, width: 500"]

[tr]

[td]

Original row number

[/td]

[td]

Text

[/td]

[/tr]

[tr]

[td]

5

[/td]

[td]

Text5 < 72 Chars

[/td]

[/tr]

[tr]

[td]

6

[/td]

[td]

Text6 First 72 Chars

[/td]

[/tr]

[tr]

[td]

6

[/td]

[td]

Text6 Second 72 Chars

[/td]

[/tr]

[tr]

[td]

6

[/td]

[td]

Text6 Third 72 Chars

[/td]

[/tr]

[tr]

[td]

7

[/td]

[td]

Text7 <72 Chars

[/td]

[/tr]

[/TABLE]

Grimes0332 · Apr 25th 2016

Re: Splitting Text in a Cell to a set lenght

You could simply add another check in the IF...ElseIf block for the cell containing some text (Text and line breaks will be caught earlier) and include the row number of the passed Range 'Source' in the column to the left when the value of Output is written to a cell.

Remember this works for 1 cell at a time, in line with your original requirement - "Splitting Text in a Cell to a set lenght"

Dave80 · Apr 25th 2016

Re: Splitting Text in a Cell to a set lenght

Aye, cheers got it working now. That was enough of a pointer for the penny to finally drop!

Splitting Text in a Cell to a set lenght

Participate now!

Share