Extract specific length numbers from string and create new string with those numbers

Question

I have a text field that I need to extract certain numbers from. The number will always be 7 digits long but the location within the string is not known and how many are in the string is also not known.

A sample string is "SF WO 1564892 DUE 5/19 FIN WO 1638964 DUE 5/27". I want to be able to extract 1564892 and 1638964 and have it generate a new string like "1564892;1638964" and continue to add ";number" if there are more in the string. I use the new string to find and return the largest of these numbers.

I found this and it kind of works but it will also return "1234567" from the string "123456789" which is undesired.

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

I would prefer the solution be in VBA and not a function but I am open to anything.

You could add an additional condition to the If NumberCounter = DigitLength Then line of code that checks if the next character is a space or not, for example: If NumberCounter = DigitLength And Mid(Alphanumeric, r + 1, 1) = " " Then — Jordan
– Jordan, Commented Mar 24, 2016 at 13:51

Siddharth Rout · Accepted Answer · 2016-03-24 14:04:06Z

What you want can be achieved using RegEx but since I am stepping out so here is a very simple alternative :)

Sub Sample()
    Dim s As String
    Dim MyAr As Variant
    Dim i as Long

    s = "Thisis a Sample1234567-Blah12341234\1384156 Blah Blah 1375188 and more Blah 20 Section 1"

    For i = Len(s) To 1 Step -1
        Select Case Asc(Mid(s, i, 1))
        Case 48 To 57
        Case Else
            s = Replace(s, Mid(s, i, 1), "a")
        End Select
    Next i

    Do While InStr(1, s, "aa")
        s = Replace(s, "aa", "a")
    Loop

    MyAr = Split(s, "a")

    For i = LBound(MyAr) To UBound(MyAr)
        If Len(Trim(MyAr(i))) = 7 Then Debug.Print MyAr(i)
    Next i
    '
    ' This will Give you 1234567, 1384156 and 1375188
    '
End Sub

Edit

Logic

Replace anything in that string which is not a number with any alphabet
Replace double instancs of that alphabet till only one remains
Split on that alphabet
Loop and check for the length.
I have displayed those numbers. You can join them

Hadi · Accepted Answer · 2016-03-24 14:25:40Z

2

I faced such thing in the past, and hope this approach will help.

Function Extract7Digits(s As String) As String

Dim i As Long 
Dim SevenDigits As String 
Dim s2 As String

s2 = Replace(s, " ", "|") 
i = 1 
While i < Len(s2) - 7
    If IsNumeric(Mid(s2, i, 7)) Then
        SevenDigits = SevenDigits & Mid(s2, i, 7) & ";"
        i=i+6
    End If
    i = i + 1 
Wend
    Extract7Digits = SevenDigits 
End Function

Best.

edited Mar 24, 2016 at 14:25

answered Mar 24, 2016 at 14:17

Hadi

1841 silver badge10 bronze badges

Comments

Pradeep Kumar · Accepted Answer · 2016-03-24 15:06:40Z

You can use Regex which is much easier than looping over the whole string.

The regex being used is \b\d{7}\b which means 7 digits delimited by word boundary.

Public Function ExtractDigits(Alphanumeric As String, DigitLength As Long) As String
    Dim regEx As Object, matches As Object
    Dim i As Long
    Dim output As String

    Set regEx = CreateObject("VBScript.RegExp")
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .pattern = "\b\d{" & DigitLength & "}\b"
    End With

    Set matches = regEx.Execute(Alphanumeric)
    For i = 0 To matches.Count - 1
        output = output & matches(i) & ";"
    Next
    If Len(output) > 0 Then output = Left(output, Len(output) - 1)
    ExtractDigits = output
End Function

LMM9790 · Accepted Answer · 2016-03-24 13:50:29Z

Can your problem be solved by adding an additional If-statement that tests whether the character after the 7th number is a number as well and ignore the number if that is the case?

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
Dim r As Integer


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 (Not IsNumeric(Mid(Alphanumeric, r + 1, 1))) Then
                If NewString = "" Then
                    NewString = TempString
                Else
                NewString = NewString & ";" & TempString
                End If
            End If
        End If
    End If
    If Not IsNumeric(CurrentCharacter) Then
        NumberCounter = 0
        TempString = ""
    End If
Next

ExtractDigits = NewString

End Function

Collectives™ on Stack Overflow

Extract specific length numbers from string and create new string with those numbers

4 Answers 4

Comments

Comments

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

Comments

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related