Split Cell based on LowerUpper case?

JazzSP8

JazzSP8

Well-known Member
Joined
Sep 30, 2005
Messages
1,233
Office Version
  1. 365
Platform
  1. Windows
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;

Code: 
Computer ProductsDrivesDVDExternal

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

Code: 
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 :)
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
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.
 
Upvote 0
You could use this - just select the data first:
Code: 
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
 
Upvote 0
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-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
Code: 
[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:p></o:p>
Similarly, it works on whatever range you have selected.<o:p></o:p>
<o:p></o:p>
 
Last edited:
Upvote 0
Rory,
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
That CamelCase code gave me some unexpected results, i.e. (slash to indicate column splits)

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

Value: AbCdEf
Expected Result: Ab / CD / Ef
Actual Result: Ab / CdEf
 
Upvote 0
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! :)
 
Upvote 0
RegExp is not my forte so I'm treating this as a learning experience!
Click to expand...
same is the case here,:)

here is my try,

Code: 
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,:)
 
Upvote 0
Hi

Another option. I selected A1:A4 and ran:

Code: 
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
ABCDEF
1Computer ProductsDrivesDVDExternalComputer ProductsDrivesDVDExternal
2DVDExternalDVDExternal
3AbCdEfAbCdEf
4Some MoreCamelCaseTest TextSome MoreCamelCaseTest Text
Sheet2
 
Last edited by a moderator:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
VBA to split table and retain formatting
Replies
1
Views
396
XLfriend777
XLfriend777
J
  • Solved
VBA script - split sheets into unique folder named of cell entry
Replies
7
Views
457
james00
J
D
  • Question
Autofilling multiple cells
Replies
1
Views
149
Logit
Logit
C
  • Question
Populating different sheets based on the value in a column on another sheet.
Replies
3
Views
434
DanteAmor
DanteAmor
E
  • Question
Setting NumberFormat for a cell via a VBA function
2 3
Replies
21
Views
803
Joe4
Joe4

Forum statistics

Threads
1,221,197
Messages
6,158,470
Members
451,495
Latest member
Jatin Bhagdev

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top