# A Simple Alphanumeric Splitting Problem

#### kale_81

##### New Member
Hello all:

I've got to say i'm quite impressed with this forum, and have learned much from the members here in my 6 months lurking here. For that, I thank you all truly. I have, however, come across a problem I cannot seem to solve, and must ask for some help.

I'm trying to split a single alphanumeric column into individual cells. I've been working on making it easy so that I can highlight the individual column that this information resides in, then be able to run a macro to split it up into the next several columns.

JK63 HD1
JK4HD1
ZY356
DJ 3458 HD2

I'd like it to be able to read:

A........B.......C........D

JK.......63.....HD......1
JK.......4.......HD......1
ZY......356
DJ......3458...HD......2

The idea is to have the first two letters in the first column, followed by the numerical string (1-4 numbers long depending) in the next column, followed finally by the next set of letters, and the single number after that. The catch is that the original letter/numbers may or may not have spaces between them, and more importantly, the first series of numbers goes from 1 all the way to 9999, meaning that the forumla would have to account for this somehow.

I've tried altering Mr. Pearson's telephone and name parsing code to make this work, but have only met failure time and again. Does anyone have any input they might give me to make something seemingly so simple work? I'd hate to have to modify all 80,000 lines manually. Thanks much, Chris

### Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

#### jindon

##### MrExcel MVP
Hi

vba
Code:
``````Sub test()
Dim r As Range, txt As String, s As String, a()
Dim i As Long, n As Long
With ActiveSheet
For Each r In .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
If Not IsEmpty(r) Then
txt = Replace(r.Text, Chr(32), ""): i = 1
Do While Len(Trim(txt)) > 0
x = Mid\$(txt, i, 1)
Select Case x
Case 0 To 9
y = Val(Mid(txt, i))
n = n + 1
If Len(s) > 0 Then n = n + 1
ReDim Preserve a(1 To n)
On Error Resume Next
a(n - 1) = s
Err.Clear
a(n) = y
txt = Right\$(txt, Len(txt) - Len(s) - Len(y))
i = 0
y = Empty: s = Empty
Case Else
s = s & Mid\$(txt, i, 1)
End Select
i = i + 1
If i > Len(txt) Then Exit Do
Loop
End If
r.Offset(, 1).Resize(, UBound(a)) = a: n = Empty
Erase a
Next
End With
End Sub``````

#### kale_81

##### New Member
jindon, I think this is what I am looking for. Thanks so much for your time. I seem to be getting an error, however, i'm not sure if because of something i'm doing.

I continue to get "compile error - sub or function not defined" when I paste this into a new module and then try to run it? It continually highlights the word "replace" in line 7. Is there something else I need to do?

#### Zack Barresse

##### MrExcel MVP
Welcome to the board!

What version of Excel are you running?

#### jindon

##### MrExcel MVP

Hi
try
change
Code:
``txt = Replace(r.Text, Chr(32), "")``
to
Code:
``txt = application.substitute(r.Text, Chr(32), ""):``

#### kale_81

##### New Member
I wasn't sure it would make a difference, but I am running excel 97' leave it up to the government to not want to update in 8 years.

Thanks for the help again, I tried replacing the line, and now it is saying "Runtime error "9": Subscript out of range

I'm inferring at this point that my ancient excel file must be causing some of these problems.

#### jindon

##### MrExcel MVP

Hummmm

97 is always aproblem for me...

try this one
Code:
``````Sub test()
Dim r As Range, txt As String, s As String, a()
Dim i As Long, n As Long
With ActiveSheet
For Each r In .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
If Not IsEmpty(r) Then
txt = Application.Substitute(r.Text, Chr(32), ""): i = 1
Do While Len(Trim(txt)) > 0
x = Mid\$(txt, i, 1)
Select Case x
Case 0 To 9
y = Val(Mid(txt, i))
n = n + 1
If Len(s) > 0 Then n = n + 1
ReDim Preserve a(1 To n)
On Error Resume Next
a(n - 1) = s
Err.Clear
a(n) = y
txt = Right\$(txt, Len(txt) - Len(s) - Len(y))
i = 0
y = Empty: s = Empty
Case Else
s = s & Mid\$(txt, i, 1)
End Select
i = i + 1
If i > Len(txt) Then Exit Do
Loop
End If
If LBound(a) = 0 Then
r.Offset(, 1) = r
Else
r.Offset(, 1).Resize(, UBound(a)) = a: n = Empty
Erase a
End If
s = Empty
Next
End With
End Sub``````

#### kale_81

##### New Member
Yeah, still the same error: Runtime error "9": script out of range.

It does point to line 30, however:

If LBound(a) = 0 Then

I didn't think it would be so complicated. Sorry for the trouble!

#### jindon

##### MrExcel MVP
OK

do you want to change it to

If n=0 then

#### kale_81

##### New Member
Hmm. Now it's giving me "Runtime error 13" Type Mismatch?

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

### Forum statistics

1,168,117
Messages
5,857,482
Members
431,882
Latest member
saaaaaaaaaaaaaaaaaaaaaa

### 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.

### Which adblocker are you using?

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

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