Extract multiple and fixed lengh numbers from alphanumeric string.

Rodricon

New Member
Joined
Jan 7, 2014
Messages
2
Hope I can get some help with a problem I´m trying to solve since days ago. I apologize if this has already been asked, but I could not find any post addressing this situation.

What I have is a long alphanumeric string, and need to extract from it, all number in a row of 6 digits, showing them separated by ",", or ";".

Find below an example:

A1= "SSA REF.NNF S/19 820707sometext822845/82068flkjsdf 822845/ "

Required result:

B1 = 820707;822845;822845

Thanks for your help, any dobt just let me know. thanks!
 

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.

perimidt

Board Regular
Joined
Jan 19, 2012
Messages
132
Hi

I think the easiest way is to use a UDF, this is my attempt:
Code:
Public Function ExtractDigits(Alphanumeric As String, DigitLength As Long)Dim StringLenght As Long
Dim CurrentCharacter As String
Dim NewString As String
Dim NumberCounter As Long
Dim TempString As String


StringLenght = Len(Alphanumeric)
For r = 1 To StringLenght
    CurrentCharacter = Mid(Alphanumeric, r, 1)
    If IsNumeric(CurrentCharacter) Then
        NumberCounter = NumberCounter + 1
        TempString = TempString & CurrentCharacter
        If NumberCounter = DigitLength Then
            If NewString = "" Then
                NewString = TempString
            Else
            NewString = NewString & ";" & TempString
            End If
        End If
    End If
    If Not IsNumeric(CurrentCharacter) Then
        NumberCounter = 0
        TempString = ""
    End If
Next


ExtractDigits = NewString


End Function

If you haven't used a UDF before just press ALT+F11, insert module and paste the code.

To use it on the spreadsheet type =ExtractDigits(A1,6) in B1.

The number 6 is is the length of the number you want to extract.
 

perimidt

Board Regular
Joined
Jan 19, 2012
Messages
132
Just realized that it would give a wrong answer if you had two numbers right next to each other, try this instead:
Code:
Public Function ExtractDigits(Alphanumeric As String, DigitLength As Long)Dim StringLenght As Long
Dim CurrentCharacter As String
Dim NewString As String
Dim NumberCounter As Long
Dim TempString As String


StringLenght = Len(Alphanumeric)
For r = 1 To StringLenght
    CurrentCharacter = Mid(Alphanumeric, r, 1)
    If IsNumeric(CurrentCharacter) Then
        NumberCounter = NumberCounter + 1
        TempString = TempString & CurrentCharacter
        If NumberCounter = DigitLength Then
            If NewString = "" Then
                NewString = TempString
                NumberCounter = 0
                TempString = ""
            Else
            NewString = NewString & ";" & TempString
            NumberCounter = 0
            TempString = ""
            End If
        End If
    End If
    If Not IsNumeric(CurrentCharacter) Then
        NumberCounter = 0
        TempString = ""
    End If
Next


ExtractDigits = NewString


End Function
 

VBA Geek

MrExcel MVP
Joined
Dec 16, 2013
Messages
2,857
an alternative :) first argument your text, second argument is the numbers of characters you wish to extract, ex 6

cheers!

Code:
Public Function SPLITME(ByVal myString As String, XXX As Integer)
myString = Trim(myString)


Dim i As Integer, x As Integer
Dim myTemp
Dim Tempy
Dim Arr


For i = 1 To Len(myString)


    Select Case Mid(myString, i, 1)
    
    Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 0
        myTemp = myTemp & Mid(myString, i, 1)
    Case Else
        myTemp = myTemp & "-"
    End Select
Next


Arr = Split(myTemp, "-")


For x = 0 To UBound(Arr)
    If Len(Arr(x)) = XXX And IsNumeric(Arr(x)) Then
        Tempy = Tempy & Arr(x) & ";"
    End If
Next


If Len(Tempy) > 0 Then Tempy = Left(Tempy, Len(Tempy) - 1)


SPLITME = Tempy


End Function
 
Last edited:

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649

ADVERTISEMENT

VBA Geek, perimidt,

Nicely done - two functions for my archives - thanks.
 

apo

Well-known Member
Joined
Nov 3, 2008
Messages
581
Maybe this too..
Code:
Private Sub CommandButton1_Click()
    Dim objRegex, n
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Global = True
        .Pattern = "\d{6}"
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
            Set myMatches = .Execute(Cells(i, 1))
            For Each n In myMatches
                If Cells(i, 2).Value = "" Then
                    Cells(i, 2).Value = n
                Else
                    Cells(i, 2).Value = Cells(i, 2).Value & ";" & n
                End If
            Next n
        Next i
    End With
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,685
Messages
5,637,808
Members
416,983
Latest member
LessThanAverageUser

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