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.

Answer 1

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

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