Extract specific length strings from a string and create a new string with these numbers

Question

I have a text box from which I need to extract certain numbers. The number will always be 7 digits, but the location inside the line is unknown and how many in the line is also unknown.

Example line: "SF WO 1564892 DUE 5/19 FIN WO 1638964 DUE 5/27". I want to be able to extract 1564892 and 1638964 and generate a new line like "1564892; 1638964" and continue to add "number" if there is more in the line. I use a new line to search and return the largest of these numbers.

I found this and it seems to work, but it will also return “1234567” from the string “123456789”, which is undesirable.

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 to be in VBA rather than in function, but I'm open to anything.

Answer 1

, If, , 7- , ?

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

Answer 2

, , RegEx, , :)

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

• - ,
• instancs ,
• .
• . .

Answer 3

Regex, , .

\b\d{7}\b, 7 , .

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

Answer 4

I have encountered this situation in the past and hope this approach helps.

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.