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
 

Some videos you may like

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.

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!
 

Watch MrExcel Video

Forum statistics

Threads
1,118,032
Messages
5,569,767
Members
412,291
Latest member
marypolitan
Top