Extract multiple and fixed lengh numbers from alphanumeric string.

[Rodricon]

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!

 

[perimidt]

Hi

I think the easiest way is to use a UDF, this is my attempt:

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]

Just realized that it would give a wrong answer if you had two numbers right next to each other, try this instead:

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]

an alternative first argument your text, second argument is the numbers of characters you wish to extract, ex 6

cheers!

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

 

[hiker95]

VBA Geek, perimidt,

Nicely done - two functions for my archives - thanks.

 

[apo]

Maybe this too..

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

 

[Rodricon]

Terrific, worked perfectly. Thank you all guys!