I wasn't quite sure what you mean by "the entire alphabet" and up to about
38-65 numerically.
I kind of got the impression that maybe you had to deal with things like
AA01a43bb2CA99
But no matter, the following code will deal with things just as you've shown
them, to an entry of virtually any length composed of alpha and numeric
groups.
It does assume that the cells to the right of your entries on a row are
available to put the split groups into.
Sub SplitIntoGroups()
Dim sourceEntries As Range
Dim anySourceEntry As Range
Const entriesColumn = "A" ' assumes in col A
Const firstEntryRow = 2 ' first row w/value to examine
Dim lastEntryRow As Long ' will be determined
Dim workingText As String
Dim columnOffset As Integer
Dim seekingAlphaGroup As Boolean
Dim LC As Integer ' loop counter
Dim splitPoint As Integer
Set sourceEntries = ActiveSheet.Range(entriesColumn & _
firstEntryRow & ":" & ActiveSheet.Range(entriesColumn & _
Rows.Count).End(xlUp).Address)
For Each anySourceEntry In sourceEntries
'find column number of first column to put
columnOffset = 1 'reset
' Trim() removes leading/trailing white space
workingText = Trim(anySourceEntry.Value)
'determine whether the string starts
'with an alpha or numeric group
seekingAlphaGroup = True
If Left(workingText, 1) >= "0" And _
Left(workingText, 1) <= "9" Then
seekingAlphaGroup = False
End If
Do Until Len(workingText) = 0
'assumption here is that any entry
'ALWAYS begins with an alpha group
If seekingAlphaGroup Then
'we actually look for a digit 0-9 here
splitPoint = 0 ' reset
For LC = 1 To Len(workingText)
If Mid(workingText, LC, 1) >= "0" And _
Mid(workingText, LC, 1) <= "9" Then
splitPoint = LC - 1
Exit For ' found where to split it
End If
Next
Else
'looking for a numeric group
'so we look for an alpha character
splitPoint = 0 ' reset
For LC = 1 To Len(workingText)
'assume if > "9" then it's alpha
If Mid(workingText, LC, 1) > "9" Then
splitPoint = LC - 1
Exit For
End If
Next
End If
If splitPoint = 0 Then
'the remainder of workingText is
'all of one type (alpha or numeric)
' put single quote in front of it
'to retain leading zeros if it is numeric
anySourceEntry.Offset(0, columnOffset) = _
"'" & workingText
workingText = ""
Else
'not done, more to follow
' put single quote in front of it
'to retain leading zeros if it is numeric
anySourceEntry.Offset(0, columnOffset) = _
"'" & Left(workingText, splitPoint)
workingText = Right(workingText, _
Len(workingText) - splitPoint)
End If
'flip the switch
seekingAlphaGroup = Not seekingAlphaGroup
columnOffset = columnOffset + 1
Loop
Next
Set sourceEntries = Nothing
End Sub
To put the code into your workbook: Press [Alt]+[F11] to enter the VB
Editor. Then choose Insert | Module to get an empty module displayed. Copy
the code above and paste it into the module. Close the VB Editor and save
the workbook.
You can change the constants entriesColumn and firstEntryRow to define where
the first text group to be split up is at.
To run the code, select the sheet with your entries and then use Tools Macro
Macros and select the splitIntoGroups entry in the list and click the [Run]
button.
Hope this helps some.
Dvinechild said:
Hello All,
I'm looking to seperate out a list of alpha-numeric codes into seperate
columns. sound too easy? Here's the catch:
Examples:
A01 (single aplha, 2-digit num) = A - 01
A01a (single aplha, 2-digit num, sub-alpha) = A - 01 - a
AA01 (2-alpha, 2-digit num) = AA - 01
AA01a (2-aplha, 2-digit num, sub-alpha) = AA - 01 - a
If anyone knows how to get this to split up correctly, unfortunately I have
to do it for pretty much the entire alphabet and up to about 38-65
numerically.
Please advise or lead me in the rigth direction.
