macro to split words to 5 columns

I have a column Title as shown in the attached excel OriginalColumn.
I need to split this column into 5 different columns with max of 35 characters each.
The rules are:
1)Maximum characters allowed in each of these split columns shouldn't exceed 35 characters.
2)The split columns as shown in sample data requiredsplitcolumn shouldn't be cut in middle of a word.  


So, basically I need to split the words without cutting them in the middle ...but then for some bigger Titles if split columns exceeds more than 35 characters length it should be cut at a different point (e.g character 32) to reflect a complete word.
This applies to  each of the five split columns.

Any ideas how to get my required Final resultset???
OriginalColumn.xlsx
RequiredSplitColumn.xlsx
jen RadAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

David Johnson, CD, MVPOwnerCommented:
I'd split on the comma rather than the length (35)
The problem being is that your data is unstructured
0
nutschCommented:
How about this?

B3:
=LEFT($A3,FIND("|",SUBSTITUTE(LEFT($A3,35)," ","|",LEN(LEFT($A3,35))-LEN(SUBSTITUTE(LEFT($A3,35)," ",""))))-1)

C3
=TRIM(IF(LEN($A3)-LEN($B3)-1<35,MID($A3,LEN($B3)+1,36),LEFT(MID($A3,LEN($B3)+1,LEN($A3)),FIND("|",SUBSTITUTE(LEFT(MID($A3,LEN($B3)+1,LEN($A3)),35)," ","|",LEN(LEFT(MID($A3,LEN($B3)+1,LEN($A3)),35))-LEN(SUBSTITUTE(LEFT(MID($A3,LEN($B3)+1,LEN($A3)),35)," ",""))))-1)))

D3
=TRIM(IF(LEN($A3)-(LEN($B3)+LEN($C3)+1)-1<35,MID($A3,(LEN($B3)+LEN($C3)+1)+1,36),LEFT(MID($A3,(LEN($B3)+LEN($C3)+1)+1,LEN($A3)),FIND("|",SUBSTITUTE(LEFT(MID($A3,(LEN($B3)+LEN($C3)+1)+1,LEN($A3)),35)," ","|",LEN(LEFT(MID($A3,(LEN($B3)+LEN($C3)+1)+1,LEN($A3)),35))-LEN(SUBSTITUTE(LEFT(MID($A3,(LEN($B3)+LEN($C3)+1)+1,LEN($A3)),35)," ",""))))-1)))

E3
=TRIM(IF(LEN($A3)-(LEN($B3)+LEN($C3)+LEN($D3)+2)-1<35,MID($A3,(LEN($B3)+LEN($C3)+LEN($D3)+2)+1,36),LEFT(MID($A3,(LEN($B3)+LEN($C3)+LEN($D3)+2)+1,LEN($A3)),FIND("|",SUBSTITUTE(LEFT(MID($A3,(LEN($B3)+LEN($C3)+LEN($D3)+2)+1,LEN($A3)),35)," ","|",LEN(LEFT(MID($A3,(LEN($B3)+LEN($C3)+LEN($D3)+2)+1,LEN($A3)),35))-LEN(SUBSTITUTE(LEFT(MID($A3,(LEN($B3)+LEN($C3)+LEN($D3)+2)+1,LEN($A3)),35)," ",""))))-1)))
0
jen RadAuthor Commented:
This is Perfect...Thanks nutsch!

Will test it with my data & get back to you shortly!

Thanks very Much!
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

jen RadAuthor Commented:
Hi nutsch... I have a quick question. I see that the above formula splits the Title to another column even if the length of the word is less than the 35 characters.

for Example...I have this sample Titles like shown below which are less than 35 characters...it is being split to different column? Can we just leave them in their cell if they the title length <35 in the same cell???

Sample titles that has length <35 but gets split to another column:
_______________________________________________________________________
David Cohn
Jon Milek
Mark Geth
Rick Hills
Rob Bale





Thanks very much!
0
nutschCommented:
edit B3 formula to:

=IF(LEN($A3)<36,$A3,LEFT($A3,FIND("|",SUBSTITUTE(LEFT($A3,35)," ","|",LEN(LEFT($A3,35))-LEN(SUBSTITUTE(LEFT($A3,35)," ",""))))-1))
0
jen RadAuthor Commented:
Thank you so very Much!

It works amazingly well & exactly what I wanted:)...Just a few things I happened to notice...
I have attached the sample data excel for your reference.


For this sample data shown I am getting a little glitch in the splitcolumn Title_3. Any ideas???
If I could get a fix for this , it would really help:)
Also, I will need a formula for splitcolumn Title_5 as these Titles are sometimes are really big and might extend until Title_5.



I know the data I am working with is totally unstructured data:(.But I cannot alter anything on this data as it has some important details. So had to deal with this data as is as I have no other choice:(...my bad!

Thanks very much for helping!!!
SplitColumn-test2.xlsx
0
nutschCommented:
in D2

=TRIM(IF(LEN($A2)-(LEN($B2)+LEN($C2)+1)-1<35,IF(LEN(B2)+LEN(C2)+1=LEN(TRIM($A2)),"",MID($A2,(LEN($B2)+LEN($C2)+1)+1,36)),LEFT(MID($A2,(LEN($B2)+LEN($C2)+1)+1,LEN($A2)),FIND("|",SUBSTITUTE(LEFT(MID($A2,(LEN($B2)+LEN($C2)+1)+1,LEN($A2)),35)," ","|",LEN(LEFT(MID($A2,(LEN($B2)+LEN($C2)+1)+1,LEN($A2)),35))-LEN(SUBSTITUTE(LEFT(MID($A2,(LEN($B2)+LEN($C2)+1)+1,LEN($A2)),35)," ",""))))-1)))
0
nutschCommented:
Or, just put the code below in a module of your workbook (go Alt+F11, Insert \ Module) and in cell B2, put

=get35Chars($A7:A7)

and copy down and across. Make sure your workbook is macro-enabled.

Option Explicit
Option Compare Text
 
Function Get35Chars(rg As Range) As String
Dim sTemp As String, lLoop As Long

If rg.Rows.Count > 1 Then Exit Function

If rg.Columns.Count = 1 Then
    Get35Chars = Get35WIP(rg.Cells(1, 1))
Else
    sTemp = rg.Cells(1, 1)
    
    For lLoop = 2 To rg.Columns.Count
        sTemp = Trim(Replace(sTemp, rg.Cells(1, lLoop), ""))
    Next lLoop
    
    Get35Chars = Get35WIP(sTemp)
End If

End Function

Private Function Get35WIP(sData As String) As String
    If Len(sData) < 36 Then
        Get35WIP = sData
    Else
        Get35WIP = RegExpFind(Left(sData, 35), ".*(?=\s)", 1)
    End If
End Function

 
Function RegExpFind(LookIn As String, PatternStr As String, Optional Pos, _
    Optional MatchCase As Boolean = True, Optional ReturnType As Long = 0, _
    Optional MultiLine As Boolean = False)
    
    ' Function written by Patrick G. Matthews.  You may use and distribute this code freely,
    ' as long as you properly credit and attribute authorship and the URL of where you
    ' found the code
    
    ' This function relies on the VBScript version of Regular Expressions, and thus some of
    ' the functionality available in Perl and/or .Net may not be available.  The full extent
    ' of what functionality will be available on any given computer is based on which version
    ' of the VBScript runtime is installed on that computer
    
    ' This function uses Regular Expressions to parse a string (LookIn), and return matches to a
    ' pattern (PatternStr).  Use Pos to indicate which match you want:
    ' Pos omitted               : function returns a zero-based array of all matches
    ' Pos = 1                   : the first match
    ' Pos = 2                   : the second match
    ' Pos = <positive integer>  : the Nth match
    ' Pos = 0                   : the last match
    ' Pos = -1                  : the last match
    ' Pos = -2                  : the 2nd to last match
    ' Pos = <negative integer>  : the Nth to last match
    ' If Pos is non-numeric, or if the absolute value of Pos is greater than the number of
    ' matches, the function returns an empty string.  If no match is found, the function returns
    ' an empty string.  (Earlier versions of this code used zero for the last match; this is
    ' retained for backward compatibility)
    
    ' If MatchCase is omitted or True (default for RegExp) then the Pattern must match case (and
    ' thus you may have to use [a-zA-Z] instead of just [a-z] or [A-Z]).
    
    ' ReturnType indicates what information you want to return:
    ' ReturnType = 0            : the matched values
    ' ReturnType = 1            : the starting character positions for the matched values
    ' ReturnType = 2            : the lengths of the matched values
    
    ' If MultiLine = False, the ^ and $ match the beginning and end of input, respectively.  If
    ' MultiLine = True, then ^ and $ match the beginning and end of each line (as demarcated by
    ' new line characters) in the input string
    
    ' If you use this function in Excel, you can use range references for any of the arguments.
    ' If you use this in Excel and return the full array, make sure to set up the formula as an
    ' array formula.  If you need the array formula to go down a column, use TRANSPOSE()
    
    ' Note: RegExp counts the character positions for the Match.FirstIndex property as starting
    ' at zero.  Since VB6 and VBA has strings starting at position 1, I have added one to make
    ' the character positions conform to VBA/VB6 expectations
    
    ' Normally as an object variable I would set the RegX variable to Nothing; however, in cases
    ' where a large number of calls to this function are made, making RegX a static variable that
    ' preserves its state in between calls significantly improves performance
    
    Static RegX As Object
    Dim TheMatches As Object
    Dim Answer()
    Dim Counter As Long
    
    ' Evaluate Pos.  If it is there, it must be numeric and converted to Long
    
    If Not IsMissing(Pos) Then
        If Not IsNumeric(Pos) Then
            RegExpFind = ""
            Exit Function
        Else
            Pos = CLng(Pos)
        End If
    End If
    
    ' Evaluate ReturnType
    
    If ReturnType < 0 Or ReturnType > 2 Then
        RegExpFind = ""
        Exit Function
    End If
    
    ' Create instance of RegExp object if needed, and set properties
    
    If RegX Is Nothing Then Set RegX = CreateObject("VBScript.RegExp")
    With RegX
        .Pattern = PatternStr
        .Global = True
        .IgnoreCase = Not MatchCase
        .MultiLine = MultiLine
    End With
        
    ' Test to see if there are any matches
    
    If RegX.test(LookIn) Then
        
        ' Run RegExp to get the matches, which are returned as a zero-based collection
        
        Set TheMatches = RegX.Execute(LookIn)
        
        ' Test to see if Pos is negative, which indicates the user wants the Nth to last
        ' match.  If it is, then based on the number of matches convert Pos to a positive
        ' number, or zero for the last match
        
        If Not IsMissing(Pos) Then
            If Pos < 0 Then
                If Pos = -1 Then
                    Pos = 0
                Else
                    
                    ' If Abs(Pos) > number of matches, then the Nth to last match does not
                    ' exist.  Return a zero-length string
                    
                    If Abs(Pos) <= TheMatches.Count Then
                        Pos = TheMatches.Count + Pos + 1
                    Else
                        RegExpFind = ""
                        GoTo Cleanup
                    End If
                End If
            End If
        End If
        
        ' If Pos is missing, user wants array of all matches.  Build it and assign it as the
        ' function's return value
        
        If IsMissing(Pos) Then
            ReDim Answer(0 To TheMatches.Count - 1)
            For Counter = 0 To UBound(Answer)
                Select Case ReturnType
                    Case 0: Answer(Counter) = TheMatches(Counter)
                    Case 1: Answer(Counter) = TheMatches(Counter).FirstIndex + 1
                    Case 2: Answer(Counter) = TheMatches(Counter).Length
                End Select
            Next
            RegExpFind = Answer
        
        ' User wanted the Nth match (or last match, if Pos = 0).  Get the Nth value, if possible
        
        Else
            Select Case Pos
                Case 0                          ' Last match
                    Select Case ReturnType
                        Case 0: RegExpFind = TheMatches(TheMatches.Count - 1)
                        Case 1: RegExpFind = TheMatches(TheMatches.Count - 1).FirstIndex + 1
                        Case 2: RegExpFind = TheMatches(TheMatches.Count - 1).Length
                    End Select
                Case 1 To TheMatches.Count      ' Nth match
                    Select Case ReturnType
                        Case 0: RegExpFind = TheMatches(Pos - 1)
                        Case 1: RegExpFind = TheMatches(Pos - 1).FirstIndex + 1
                        Case 2: RegExpFind = TheMatches(Pos - 1).Length
                    End Select
                Case Else                       ' Invalid item number
                    RegExpFind = ""
            End Select
        End If
    
    ' If there are no matches, return empty string
    
    Else
        RegExpFind = ""
    End If
    
Cleanup:
    ' Release object variables
    
    Set TheMatches = Nothing
    

End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jen RadAuthor Commented:
Nutsch...Thank you very much. Sure, I Will also try your above solution & let you know.

In the meantime, I was just testing my crappy data...and I came across few things. Maybe if you could review it
Attached is the file for your reference.


Thank you soo very much!!!...you are really great:)
SplitColumn-test3.xlsx
FewFixes.jpg
0
jen RadAuthor Commented:
Hi Nutsch...a quick question. Am sorry am not very familiar with the excel and relatively new to this.
After I added the above code to the new module  & I trying to get this to run using Ctrl+F8. what am I missing? It doesn't show up with the name of the macro for me to choose to run. Any ideas??
I have attached the files and the screenshot ...for your reference.
Can you please provide me the step to step instructions to get this work on the excel?


Thank you very much...Nutsch!
RunMacroScreen1.jpg
AddedFormulaToB2Cell.jpg
SplitColumn-macrotest1.xlsm
0
nutschCommented:
It's not a macro, it's a user defined function (udf). You copy it in a module like a macro, but you call it in a cell like other functions. In this case, write in cell b2

=get35chars($a2:a2)
0
jen RadAuthor Commented:
so..i copy it in cell b2 and dragged it down...and then what do I do for the other columns??Please advice!

AddedToB2Cell.jpg
0
nutschCommented:
Copy / paste
0
jen RadAuthor Commented:
so should I copy /paste the same to the other four cells??
=get35chars($a2:a2)
0
jen RadAuthor Commented:
copy/paste the same to other columns??...gives the same result as B column

AddedToC2D2Cell.jpg
0
jen RadAuthor Commented:
ok...now I got it!...
0
jen RadAuthor Commented:
Excellent!...Thank you sooo much:)
0
jen RadAuthor Commented:
Brilliant!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.