Split data into next columns with 70 characters maximum

Dazzawm · Jul 18, 2018

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

Dazzawm · Oct 1, 2018

MickG said:

Try this:-

Code:

[COLOR=Navy]Sub[/COLOR] MG18Jul49
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, Ray, Sp [COLOR=Navy]As[/COLOR] Variant, K [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nLen [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] nStr [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range("B2", Range("B" & Rows.Count).End(xlUp))
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    
    Sp = Split(Dn.Value, "/ ")
    [COLOR=Navy]If[/COLOR] UBound(Sp) = 0 [COLOR=Navy]Then[/COLOR]
        Dn.Offset(, 1).Value = Dn
    [COLOR=Navy]Else[/COLOR]
        [COLOR=Navy]For[/COLOR] n = 0 To UBound(Sp)
          [COLOR=Navy]If[/COLOR] Not .Exists(Sp(n)) [COLOR=Navy]Then[/COLOR]
            .Add (Sp(n)), Nothing
          [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] n
        ReDim Ray(1 To .Count)
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
          nLen = nLen + Len(K)
                    [COLOR=Navy]If[/COLOR] nLen > 70 [COLOR=Navy]Then[/COLOR]
                        nLen = Len(K)
                         c = c + 1
                         Ray(c) = nStr
                        nStr = K
                    [COLOR=Navy]Else[/COLOR]
                        nStr = nStr & IIf(nStr = "", K, "/ " & K)
                    [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] K
    
            [COLOR=Navy]If[/COLOR] nStr > "" [COLOR=Navy]Then[/COLOR]
                c = c + 1
                Ray(c) = nStr
            [COLOR=Navy]End[/COLOR] If
            Dn.Offset(, 1).Resize(, c).Value = Ray
            Dn.Offset(, 1).Resize(, c).WrapText = True
            c = 0: nStr = "": nLen = 0
    [COLOR=Navy]End[/COLOR] If
  [COLOR=Navy]End[/COLOR] With
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Hi Mick, not sure whats happened but this code isn't splitting by <70. Some cells say 74, 75 etc by using LEN function. Not sure if it ever worked and I never noticed?

Rick Rothstein · Oct 1, 2018

Dazzawm said:
Hi Mick, not sure whats happened but this code isn't splitting by <70. Some cells say 74, 75 etc by using LEN function. Not sure if it ever worked and I never noticed?

Does this code work for you (you execute the WrapTextOnSpacesWithMaxCharactersPerLine macro, it will call the Uniques function as it needs to)...

Code:

[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

  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(CellWithText.Value, " ")
    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
    CellWithText.Offset(, DestinationOffset).Value = SplitText & Text
  Next
  Columns("C").TextToColumns , xlDelimited, , , False, False, False, False, True, vbLf
  Exit Sub
NoCellsSelected:
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 · Oct 1, 2018

Thanks Rick that seemed to do it.

Dazzawm · Jan 14, 2019

Hi Rick, just went to use this but I noticed some but not all that when it gets split it has a trailing '/' like below. Any way this could be removed please? Like after the 8061 in B.

Excel 2010

	B	C
12-31-7-515-030-02/ 7515030/ 7515030-02/ 12317515030/ 8061/	0986080610/ AL9434X/ YLE102340/ YLE102340

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

</tbody>

Sheet3

Dazzawm · Jan 14, 2019

I am also coming across quite a few with more than 70 characters?

Rick Rothstein · Jan 14, 2019

Dazzawm said:
Hi Rick, just went to use this but I noticed some but not all that when it gets split it has a trailing '/' like below. Any way this could be removed please? Like after the 8061 in B.

Excel 2010

B C
12-31-7-515-030-02/ 7515030/ 7515030-02/ 12317515030/ 8061/ 0986080610/ AL9434X/ YLE102340/ YLE102340

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

</tbody>
Sheet3

Dazzawm said:
I am also coming across quite a few with more than 70 characters?

Can you post a copy of the workbook that is demonstrating these problems to DropBox so I can download it and see how my code is interacting with your actual data?

Dazzawm · Jan 14, 2019

Do you want it before or after I have run the code?

Rick Rothstein · Jan 14, 2019

Dazzawm said:
Do you want it before or after I have run the code?

Before... I want to watch the code interact with your actual data live.

Dazzawm · Jan 14, 2019

Can I PM you the link, it has sensitive data?

Rick Rothstein · Jan 14, 2019

Dazzawm said:
Can I PM you the link, it has sensitive data?

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.

Split data into next columns with 70 characters maximum

Dazzawm

Well-known Member

Dazzawm

Well-known Member

Excel Facts

Rick Rothstein

MrExcel MVP

Dazzawm

Well-known Member

Dazzawm

Well-known Member

Dazzawm

Well-known Member

Rick Rothstein

MrExcel MVP

Dazzawm

Well-known Member

Rick Rothstein

MrExcel MVP

Dazzawm

Well-known Member

Rick Rothstein

MrExcel MVP

Similar threads

Forum statistics

Share this page

Split data into next columns with 70 characters maximum

Well-known Member

Well-known Member

Excel Facts

MrExcel MVP

Well-known Member

Well-known Member

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock