A Simple Alphanumeric Splitting Problem

kale_81

New Member
Joined
May 23, 2005
Messages
7
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.

It reads something like this:

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
Joined
Aug 21, 2004
Messages
16,995
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
Joined
May 23, 2005
Messages
7
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
Joined
Dec 9, 2003
Messages
10,881
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
  3. Web
Welcome to the board!

What version of Excel are you running?
 

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995

ADVERTISEMENT

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

kale_81

New Member
Joined
May 23, 2005
Messages
7
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
Joined
Aug 21, 2004
Messages
16,995

ADVERTISEMENT

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
Joined
May 23, 2005
Messages
7
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!
 
Master Excel Bundle

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

Threads
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.
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
Top