Extract Alphanumerics From String

[EROEI]

Hi,

I have many strings of arbitrarily length. Each string always
has one number (0-9) component and one alpha-character (A-Z) component.
The order of the components in the string is entirely random.
Sometimes numbers come first and sometimes letters/characters.

Also, the length of each separate component is also varies and
there is no fixed rule to how long it will be each time.

Examples are:

String: RGH45 Alpha: RGH Num: 45
String: 4589THF Alpha:THF Num: 4589
String: FGGFFF56464645464 Alpha:FGGFFF Num: 56464645464
String: sdgdfgdfg874645 Alpha:sdgdfgdfg Num: 874645
String: 54sfsdfdsf Alpha:sfsdfdsf Num: 54
String: s54654646 Alpha:s Num: 54654646

etc..

I want to have two strings. One called Alpha and One called Num
I want to have the alpha-character component to be extracted from the string
and set to Alpha and the numerical component to be extracted & set to Num.

How/what is the Excel Macro VB code to accomplish this from within the macro?


Thanks a lot!

[turtle44]

Is this what you need?

Public Function ExtractNumeric(TextString As String) As String 
    Dim x As Long 
    Dim sDigit As String 
     
    ExtractNumeric = vbNullString 
    For x = 1 To Len(TextString) 
        sDigit = Mid(TextString, x, 1) 
        If sDigit >= "0" And sDigit <= "9" Then 
            ExtractNumeric = ExtractNumeric & sDigit 
        End If 
    Next x 
End Function 
 
Public Function ExtractAlpha(TextString As String) As String 
    Dim x As Long 
    Dim sChar As String 
     
    ExtractAlpha = vbNullString 
    For x = 1 To Len(TextString) 
        sChar = Mid(TextString, x, 1) 
        If sChar Like "[a-zA-Z]" Then 
            ExtractAlpha = ExtractAlpha & sChar 
        End If 
    Next x 
End Function 

[bryce]

This is an adaption of turtle44's response who helped me finish my code with his. Thanks turtle44, I was stuck for a while.

Sub FindText() 
     
    Dim ws As Worksheet 
    Dim x As Integer, y As Integer, z As Integer 
    Dim w As String, digit As String, alpha As String 
     
    Set ws = Worksheets("Sheet1") 
     
    For x = 2 To 7 
        digit = vbNullString 
        alpha = vbNullString 
        y = Len(Trim(ws.Range("B" & x).Value)) 
        For z = 1 To y 
            w = Mid(ws.Range("B" & x), z, 1) 
            If IsNumeric(w) Then 
                digit = digit & w 
            Else 
                alpha = alpha & w 
            End If 
        Next 
        ws.Range("C" & x).Value = alpha 
        ws.Range("D" & x).Value = digit 
    Next x 
End Sub 

EDIT - I noticed that I had

Trim(Len(ws.Range("B" & x).Value)) 
 
which does Not make sense. You would want To eliminate the spaces first I think. It should be 
 
Len(Trim(ws.Range("B" & x).Value)) 

This change is not reflected in the attached workbook

[Dave Hawley]

See also
Get Numbers From Alphanumeric Text in Excel

[jindon]

Numbers:
=AlphaNum(A1,True)

Else
=AlphaNum(A1,False)

Function AlphaNum(txt As String, Optional numOnly As Boolean = True) 
    With CreateObject("VBScript.RegExp") 
        .Pattern = IIf(numOnly=True,"\d+",\D+") 
        AlphaNum = .exexute(txt)(0) 
    End With 
End Function 

[Ger Plante]

Jindon - nice code mate...

I wasnt the OP, but took a look at the code... Two typos in the code as far as I can see (or at least needed to be fixed to run without compile error -> a double quote missing from \D and "execute" typo)...

Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String 
     
    With CreateObject("VBScript.RegExp") 
        .Pattern = IIf(numOnly = True, "\d+", [B]"[/B]\D+") 
        AlphaNum = .[B]Execute[/B](txt)(0) 
    End With 
End Function 

Just curious, is it possible to amend this to get this to return ALL Alpha characters and / or ALL numerics?

Currently 123456abcdefg098762z1x2 would return 123456 (and ignore 09876212)...

This could be a keeper.
Ger

[Dave Hawley]

Ger, to get all numeric from Alphanumerics see It allows the option to take decimals and/or negative numbers.

[jindon]

Thanks Ger

Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String 
     
    With CreateObject("VBScript.RegExp") 
        .Pattern = IIf(numOnly = True, "-?\d+(\.\d+)?", "\D+") 
        AlphaNum = .Execute(txt)(0) 
    End With 
End Function 

[Ger Plante]

Thanks Dave - I had a look at that alright... but for the moment, I'm trying to learn Regular Expressions - just because I'm slightly nuts right now... persistent rain does that to a man

Jindon, sorry Mate, I just couldnt get your code to return all instances of Letters (or all instances of numbers). Your code would only return the first "Group" of digits or letters... As I say, I'm only learning Regexp at the moment, and did some research into it. I found a great link here -
http://www.vbaexpress.com/kb/getarticle.php?kb_id=68

(with downloadable examples too....)

After some messing with the examples at the above site, the following code seemed to do the trick for me.

Function AlphaNum(txt As String, Optional numOnly As Boolean = True) As String 
    Dim my_Collection As Object 
    Dim my_match As Object 
    Dim my_string As String 
    Dim RegExp As Object 
     
    With CreateObject("VBScript.RegExp") 
        .Global = True 
        .Pattern = IIf(numOnly = True, "[\d+]", "[\D+]") 
        Set my_Collection = .Execute(txt) 
        For Each my_match In my_Collection 
            my_string = my_string & my_match 
        Next 
        AlphaNum = my_string 
    End With 
End Function 

As I say, dont know much about Regular Expressions, so I am not sure if thats the quickest Regular Expression to do the job...

Cheers guys,
Ger

[Dave Hawley]

Ger, what do you mean by "Regular Expressions" ?