Splitting string based on case

[omnivl]

Hi
Im a bit stuck on this one, i need to split a string based on a lowercase hitting an uppercase for example:

Data
Sam JonesPaul SmithEvan Angus WalshJon Smith

Output
Sam Jones;Paul Smith;Evan Angus Walsh;Jon Smith

I have the data in column D and there will be 50000 + rows

 

[kvsrinivasamurthy]

I feel UDF is the best solution. Are you ok with UDF.

 

[Yongle]

VBA for you to test - test on a copy of some of your data

What VBA does
1 Values in column D are written to array
2 (For each array value )semi-colon inserted before upper case letter EXCEPT if previous character is a space
3 Array is written back to column D
(Amend D to another column and the values will be written there instead)

Put this in the sheet module (right-click sheet tab \ View Code \ paste in window on right )

Sub Test2()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    Dim cel As Range, myStr As String, arr As Variant, a As Long, i As Integer
    arr = Range("D2", Range("D" & Rows.Count).End(xlUp)).Value          'write values to array
        For a = 1 To UBound(arr)
            myStr = arr(a, 1)
                For i = Len(arr(a, 1)) To 2 Step -1
                    If Mid(myStr, i, 1) Like "*[A-Z]*" And Mid(myStr, i - 1, 1) <> Chr(32) Then
                        myStr = Left(myStr, i - 1) & ";" & Right(myStr, Len(myStr) - i + 1)
                    End If
                Next i
            arr(a, 1) = myStr                                           'replace single value in array
            myStr = ""
        Next a
    Range("[COLOR=#ff0000]D[/COLOR]2").Resize(UBound(arr)).Value = Application.Transpose(arr)  'write array to range
    Erase arr
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

 

[Fennek]

Hi,

just an idea: testing for

if mid(myStr, i,2) like "[a-z][A-Z]" then

 

[Yongle]

Thanks @Fennek - a simpler test is good
@omnivl
- I suggest you try the code unmodified first
- then introduce Fennek's suggestion
- the VBA be looking for a 2 character match (currently 1)
- the string is checked starting with last character
- so you may need to alter the Left&Right elements on the next line

 

[Peter_SSs]

- I suggest you try the code unmodified first

I'm wondering if you did?
When writing the result array back to the sheet, aren't you transposing a vertical array into a horizontal one but still trying to write it into a vertical range - thereby producing a column all of the same (first) value?

@omnivl
I'm also envisaging some problems for you if you have names like Kevin McManus. Your 'rule' for inserting the semicolon (& the previously suggested code) will produce Kevin Mc;Manus

My suggested code below is different in at least two ways:
- It does not require looping through the characters in the original strings, and
- It makes the assumption that a 2-character last name is less likely than the 'McManus' type issue so I have only inserted a semicolon where 2 or more lower case letters are followed by an upper case.

I have also written the results into column E. Simple change near the end of the code to over-write the column D data if you are comfortable that the code is doing what you want.

Suggest testing on a copy of your workbook anyway.

Sub SplitCase()
  Dim a As Variant
  Dim i As Long
  
  a = Range("D2", Range("D" & Rows.Count).End(xlUp)).Value
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "([a-z]{2,})([A-Z])"
    For i = 1 To UBound(a)
      a(i, 1) = .Replace(a(i, 1), "$1;$2")
    Next i
  End With
  Range("E2").Resize(UBound(a)).Value = a
End Sub

 

[Yongle]

@Peter_SSs Is quite correct
The line should in fact read

Range("D2").Resize(UBound(arr)).Value = arr 'write array to range

His code will run much faster - so best not waste your time (or your computer's time) testing my code

 

[rlv01]

@Peter_SSs
A nice solution, though names like "James MacGregor" or "Nicholas VanderKamp" will still cause problems.

 

[Peter_SSs]

.. though names like "James MacGregor" or "Nicholas VanderKamp" will still cause problems.

Sure will. Quite often impossible to get perfect text solutions in Excel.

 

[Peter_SSs]

Quite often impossible to get perfect text solutions in Excel.

Whilst I don't resile from the above, I think that most of the 'complications' raised so far relate to last names. The corollary of that is that first names tend to be simpler in nature so I think the following version should have less 'mishaps'. The only changed line from my previous code is the .Pattern line

Sub SplitCase_v2()
  Dim a As Variant
  Dim i As Long
  
  a = Range("D2", Range("D" & Rows.Count).End(xlUp)).Value
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "([a-z])([A-Z][a-z]+ )"
    For i = 1 To UBound(a)
      a(i, 1) = .Replace(a(i, 1), "$1;$2")
    Next i
  End With
  Range("E2").Resize(UBound(a)).Value = a
End Sub

Sample data in column D, results of code in column E

Excel Workbook
	D	E
1
2	Sam JonesPaul SmithEvan Angus WalshJon Smith	Sam Jones;Paul Smith;Evan Angus Walsh;Jon Smith
3	Tom Jones	Tom Jones
4
5	Ken HongPeter Hall	Ken Hong;Peter Hall
6	Sam SmithKevin McManusJim O'Connor	Sam Smith;Kevin McManus;Jim O'Connor
7	Tim SmithJames MacGregorNicholas VanderKampKim NgSonia Hall	Tim Smith;James MacGregor;Nicholas VanderKamp;Kim Ng;Sonia Hall
Split case (3)

Hopefully we will get some feedback from the OP soon.