Split data into next columns with 70 characters maximum

[Dazzawm]

I have data in column B like below. I want the data split into the next columns and each column must have a maximum of 70 characters. I don't want it cut off exactly at 70 as it may split a number within the cell. It will have to be at the last '/' before 70.

There may be some cells that won't have 70 so they can be ignored. Thanks

Excel 2010
	B
99	12-31-1-276-139/ 12-31-1-276-164/ 12-31-1-277-116/ 12-31-1-277-166/ 12-31-1-277-217/ 12-31-1-277-219/ 12-31-1-277-504/ 12-31-1-285-012/ 12-31-1-352-708/ 12-31-1-362-029/ 12-31-1-362-092/ 12-31-1-362-468/ 12-31-1-466-084/ 85-31-1-362-029/ 85-31-1-362-030
100	12-31-1-266-660/ 12-31-1-267-401/ 12-31-1-267-461/ 12-31-1-276-269/ 12-31-1-277-503/ 12-31-1-277-581/ 12-31-1-289-818/ 85-31-1-266-660/ 85-31-1-267-461/ 85-31-1-276-269
101	12-31-1-715-660/ 12-31-1-720-164/ 12-31-1-725-733/ 12-31-1-733-771/ 12311715659/ 12311733060/ 12311733772
Sheet1

 

[Rick Rothstein]

Email it to me at...

rick DOT web AT verizon DOT net

Note that I am going to bed shortly, so I'll look at it later in the day.

"web"??? Where did that come from. As you found out, that is not my email address, this is...

rick DOT news AT verizon DOT net

 

[Dazzawm]

I've sorted the less than 70 characters Rick, its just the trailing '/' if that can be sorted please.

 

[Rick Rothstein]

I've sorted the less than 70 characters Rick, its just the trailing '/' if that can be sorted please.

If I understand correctly, then I think this modified version of my Uniques function should do what you want...

Function Uniques(ByVal Text As String, Delimiter As String) As String
  Dim X As Long, Data() As String
  Text = RTrim(Text)
  If Right(Text, 1) = "/" Then Text = Left(Text, Len(Text) - 1)
  Data = Split(Text, Delimiter)
  With CreateObject("Scripting.Dictionary")
    For X = 0 To UBound(Data)
      .Item(Data(X)) = 1
    Next
    Uniques = Join(.Keys, Delimiter)
  End With
End Function

 

[Dazzawm]

No they are still there Rick. In column B below the very last '/' I don't wish to be there.

Excel 2010
	B	C
10	0 986 032 391/ 8032/ 0986080320/ AL4237X/ L8Y318300/ L8Y318300R00/	L81318300/ A003TG0091/ A3TG0091/ A3TG0091A/ A003TG0091A
11	0 986 081 300/ 608 130/ 8130/ 0986081300/ AL4074X/ AL4238N/ AL4238X/	LF1F18300/ LF1F18300R00/ LF50-18-400/ LF5018300/ LF5018300A/
12	4919/ 0986049190/ 0986049191/ AL4067X/ 37300-22650/ 3730022650/	3730022650RU
13	AL4234X/ 37300-39450/ 37300-39450RU/ 37300-39800/ 3730039450/	3730039450RU/ 3730039800/ 37300-39450
14	0986UR0178/ AL4230X/ AL4234X/ 37300-39435/ 37300-39435RU/ 3730039435/	3730039435RU/ 37300-39435R/ 37300-39600/ 3730039435R
15	0 986 049 940/ AL4068X/ 37300-38400/ 37300-38400RU/ 3730038400/	3730038400RU/ A003TA5491/ A3TA5491/ MD343416
Sheet3

 

[Dazzawm]

I have also noticed that when they get split some cells end up like this if they happen to have a single number in it. How can this be prevented please?

2.70603E+11

 

[Rick Rothstein]

I am sorry, but at this point I am going to have to see a copy of your workbook. There is something going on with your data that is not transferring correctly in your posted examples. Just so you know, the code I posted works correctly for me in the examples I create here. See Message #21 for my email address.

 

[Dazzawm]

Emailed, thank you.

 

[Rick Rothstein]

Emailed, thank you.

I think the problem I had was in interpreting exactly what you wanted, but I am glad you sent your data to me because I missed the fact from your earlier postings that some of your delimited values had spaces within them... that meant my original code produced erroneous results. The code below fixes that error in my code and also appears to properly remove the trailing slashes that you wanted removed. As to your problem with numbers being converted to E-notation... I did not see that occur anywhere after I ran the modified code below. That doesn't mean I deliberately fixed the E-notation problem because I did nothing in code related to it... I simply do not see it occurring. Replace all the code I gave you earlier with this and tell me what is now working and what is not working (if anything).

[table="width: 500"]
[tr]
	[td]Sub WrapTextOnSpacesWithMaxCharactersPerLine()
  Dim Text As String, TextMax As String, SplitText As String
  Dim Space As Long, MaxChars As Long
  Dim Source As Range, CellWithText As Range
  
  ' With offset as 1, split data will be adjacent to original data
  ' With offset = 0, split data will replace original data
  Const DestinationOffset As Long = 1
  
  Application.ScreenUpdating = False
  MaxChars = 70
  If MaxChars <= 0 Then Exit Sub
  On Error GoTo NoCellsSelected
  Set Source = Range("B2", Cells(Rows.Count, "B").End(xlUp))
  On Error GoTo 0
  For Each CellWithText In Source
    Text = Uniques(Replace(Replace(Replace(CellWithText.Value, "/ ", "//"), " ", Chr(1)), "//", "/ "), " ")
    SplitText = ""
    Do While Len(Text) > MaxChars
      TextMax = Left(Text, MaxChars + 1)
      If Right(TextMax, 1) = " " Then
        SplitText = SplitText & RTrim(TextMax) & vbLf
        Text = Mid(Text, MaxChars + 2)
      Else
        Space = InStrRev(TextMax, " ")
        If Space = 0 Then
          SplitText = SplitText & Left(Text, MaxChars) & vbLf
          Text = Mid(Text, MaxChars + 1)
        Else
          SplitText = SplitText & Left(TextMax, Space - 1) & vbLf
          Text = Mid(Text, Space + 1)
        End If
      End If
    Loop
    SplitText = Replace(SplitText & Text, Chr(1), " ")
    CellWithText.Offset(, DestinationOffset).Value = Replace(SplitText, "/" & vbLf, vbLf)
  Next
  Columns("C").TextToColumns , xlDelimited, , , False, False, False, False, True, vbLf
  Exit Sub
NoCellsSelected:
  Application.ScreenUpdating = True
End Sub

Function Uniques(Text As String, Delimiter As String) As String
  Dim X As Long, Data() As String
  Data = Split(Text, Delimiter)
  With CreateObject("Scripting.Dictionary")
    For X = 0 To UBound(Data)
      .Item(Data(X)) = 1
    Next
    Uniques = Join(.keys, Delimiter)
  End With
End Function[/td]
[/tr]
[/table]

 

[Dazzawm]

I am having an issue. When I run the code it puts the result a row up because I don't think it has headers (which I asked if possible in email). As you'll see below the data in row 2 has gone up to row 1 and the rest has done the same so they are obviously all wrong?

What you see in C2 is the data from the number in A3 and so on.

Excel 2010

	A	B	C
1			M000T34271/ M0T34271/ 23300-AA730/ SU00300451
2	WA10703N	M000T34271/ M0T34271/ 23300-AA730/ SU00300451	0001109403/ 0001109404/ 68080460AA/ 68080460AB/ K68080460AA

<colgroup><col style="width: 25pxpx" https:="" www.mrexcel.com="" forum="" usertag.php?do="list&action=hash&hash=DAE7F5"" target="_blank"></colgroup><colgroup><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet3​

 

[Dazzawm]

Did you have chance to look at this again Rick?