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

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
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:office:office" /><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:office:office" /><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 Question
VBA to split table and retain formatting
Replies
1
Views
472
XLfriend777
XLfriend777
R
  • Solved
Character count on each line within one cell
3 4 5
Replies
40
Views
759
Peter_SSs
Peter_SSs
J
  • Solved
VBA script - split sheets into unique folder named of cell entry
Replies
7
Views
514
james00
J
D
  • Question Question
Autofilling multiple cells
Replies
1
Views
222
Logit
Logit
C
  • Question Question
Populating different sheets based on the value in a column on another sheet.
Replies
3
Views
783
DanteAmor
DanteAmor

Forum statistics

Threads
1,224,516
Messages
6,179,231
Members
452,898
Latest member
Capolavoro009

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