Split Cell based on LowerUpper case?

[JazzSP8]

Hi All

I've searched for an answer to this, but, can't seem to find anything

I've got a column of data that I need to split into further columns, the only way of identifying the split from the data is if a lower case character appears next to an upper case character.

For example, a cell in column A could look like;

Computer ProductsDrivesDVDExternal

And I'd need to split that out to cover columns A B and C with

Computer Products / Drives / DVDExternal

I'd need to do that for all the cells in column A.

Can anyone suggest a way this could be achieved?

Thanks in advance, hope this makes sense

 

[Armando Montes]

Check this thread:
http://www.mrexcel.com/forum/showthread.php?p=1996401#post1996401

 

[rdwray]

The problem you have is that some of the values you want to keep together have more than 1 uppercase character and code will see this as several values. The things that you want to look at is UCase and LCase and check their value if it is true or false.

 

[JazzSP8]

Cheers Armando - Spot on, thanks

 

[RoryA]

You could use this - just select the data first:

Sub CamelCase()
   Dim rCell As Range
   Dim lCount As Long
   Application.ScreenUpdating = False
   With CreateObject("vbscript.regexp")
       .Pattern = "(\S)([A-Z]+[^A-Z])"
       .Global = True
       For Each rCell In Selection
           lCount = .Execute(rCell).Count
           If lCount Then rCell.Resize(, lCount + 1) = Split(.Replace(rCell, "$1" & Chr(1) & "$2"), Chr(1))
       Next rCell
   End With
   Application.ScreenUpdating = True
End Sub

 

[Joe4]

Well, I have been working on this for about an hour (before there were any replies), and then the site went down. I'll post it anyway so I feel that my effort is not all for naught!<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>

[COLOR=black][FONT=Verdana]Sub MyDataSplit()<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]'   Splits all selected cells<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   Dim cell As Range[/FONT][/COLOR]
[FONT=Verdana][COLOR=black]   Dim myLen As Long[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Dim i As Long[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Dim myCurCase As String[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Dim myPrevCase As String[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Dim mySplit As Long[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Dim myColumn As Long[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Dim myFirstEntry As String[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]   Application.ScreenUpdating = False[/COLOR][/FONT]
 
[FONT=Verdana][COLOR=black]'   Loop through all cells in rnage[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   For Each cell In Selection[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]'   Loop through all characters in cell[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       myLen = Len(cell)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       If myLen > 0 Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           myPrevCase = ""[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           myCurCase = ""[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           mySplit = 1[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           myColumn = 0[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           myFirstEntry = cell.Value[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           For i = 1 To myLen[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]               myPrevCase = myCurCase[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]               Select Case Asc(Mid(cell, i, 1))[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   Case 65 To 90[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                       myCurCase = "UC"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   Case 97 To 122[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                       myCurCase = "LC"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   Case 32[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                       myCurCase = "Space"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   Case Else[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                       myCurCase = "Other"[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]               End Select[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]'   If change from lower case to upper case, then split cell[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]               If myPrevCase = "LC" And myCurCase = "UC" Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   If myColumn = 0 Then[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                       myFirstEntry = Left(cell, i - 1)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   Else[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                       cell.Offset(, myColumn) = Mid(cell, mySplit, i - mySplit)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   myColumn = myColumn + 1[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]                   mySplit = i[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]               End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           Next i[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]'   Populate last value and first cells[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           cell.Offset(, myColumn) = Mid(cell, mySplit, i - mySplit)[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]           cell.Value = myFirstEntry[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]       End If[/COLOR][/FONT]
[FONT=Verdana][COLOR=black]   Next cell<o:p></o:p>[/COLOR][/FONT]
[COLOR=black][FONT=Verdana]<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]   Application.ScreenUpdating = True<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]<o:p></o:p>[/FONT][/COLOR]
[COLOR=black][FONT=Verdana]End Sub<o:p></o:p>[/FONT][/COLOR]

<o></o>
Similarly, it works on whatever range you have selected.<o></o>
<o></o>

 

[Joe4]

Rory,
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
That CamelCase code gave me some unexpected results, i.e. (slash to indicate column splits)

<o></o>
Value: DVDExternal
Expected Result: DVDExternal
Actual Result: D / VDExternal
<o></o>

Value: AbCdEf
Expected Result: Ab / CD / Ef
Actual Result: Ab / CdEf

 

[RoryA]

You're right, Joe. Insufficient testing on my part! I will try and revise it. RegExp is not my forte so I'm treating this as a learning experience!

 

[sanrv1f]

RegExp is not my forte so I'm treating this as a learning experience!

same is the case here,

here is my try,

Sub splitcl()
Dim ar, ref As Range, i As Integer
For Each ref In Selection
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([^A-Z ])([A-Z][^A-Z])"
        ar = .Replace(ref, "$1^$2")
        .Pattern = "([A-Z]+)([A-Z][^A-Z])"
        ar = .Replace(ar, "$1^$2")
    End With
    ar = Split(ar, "^")
    For i = 0 To UBound(ar)
        ref.Offset(, i + 1) = ar(i)
    Next
Next
End Sub

I couldn't figure out, how to combine the two patterns into one and remove the second replace, hope our RegExp masters notice this thread,

 

[pgc01]

Hi

Another option. I selected A1:A4 and ran:

Sub CamelCase()
Dim rC As Range
 
With CreateObject("VBScript.RegExp")
    .Pattern = "([a-z])([A-Z])"
    .Global = True
    For Each rC In Selection
        rC.Parse "[" & .Replace(rC, "$1][$2") & "]", rC.Offset(, 2)
    Next rC
End With
End Sub

Results in columns c to the right.

Book1.xlsm
	A	B	C	D	E	F
1	Computer ProductsDrivesDVDExternal		Computer Products	Drives	DVDExternal
2	DVDExternal		DVDExternal
3	AbCdEf		Ab	Cd	Ef
4	Some MoreCamelCaseTest Text		Some More	Camel	Case	Test Text
Sheet2