Extract Numeric Substring From longer String

[BrI]

I have a rather long string, actually a short paragraph, from which I want to extract a numeric string and put it into a new string.

The length of the numeric string will vary but between 7 and 12 digits and it will be the only numeric string of this length within the longer main string.

This will be a recurring scenario that I need to regularly run.

I've been looking through various string manipulation methods but don't see a solution.

Note, although I posted this in Excel thread I want to work with the string in VBA, not interact with a worksheet to resolve the string.

Any assistance?

[Paul_Hossler]

I'd try something like this

Option Explicit

Sub test()
    Dim s As String
    s = "asfadsfasdf12345678qwerqwerqwer"
    MsgBox ExtractNumbers(s)

    s = "12345678qwerqwerqwer"
    MsgBox ExtractNumbers(s)
    s = "asfadsfasdf12345678"
    MsgBox ExtractNumbers(s)
    s = "asfadsfasdf123qwerqwerqwer"
    MsgBox ExtractNumbers(s)
    s = "asfadsfasdf12345678qwer987654321qwerqwer"
    MsgBox ExtractNumbers(s)

End Sub


Function ExtractNumbers(s As String) As String  '   could be a Long
    Dim s1 As String
    Dim i As Long
    
    s1 = s
        
    'remove letters at left
    Do While Not Left(s1, 1) Like "[0-9]" And Len(s1) > 0
        s1 = Right(s1, Len(s1) - 1)
    Loop
    
    'remove letters at right
    Do While Not Right(s1, 1) Like "[0-9]" And Len(s1) > 0
        s1 = Left(s1, Len(s1) - 1)
    Loop
    
    If Len(s1) >= 7 And Len(s1) <= 12 And IsNumeric(s1) Then
        ExtractNumbers = s1
    End If
End Function

[BrI]

Thank you for that.

I tried an approximation of the string I will be using (below) but got a blank message box. Trying to extract the "50994121"

s = "Form 4 Formule 4 CERTIFICATE OF OWNERSHIP CERTIFICAT ENREGISTRE Land Act,S.N. 1981, c. L-1.1, s.63 Loi sur l'enregistrement foncier, L.N.B. de 1981, chap. L-11, art.33 wer  50994121  Owner  Propriétaire"

[mikerickson]

There are several numerals in the string that in post #3.
What value do you want returned from that string?

[BrI]

Trying to extract "50994121"
Will always want to extract the number having between 7 and 12 digits

[BrI]

Another approach might be to find the number between key words as they will always be as below:

"art.33 wer 50994121 Owner Propriétaire"

Or maybe Regex, I have been reading but am just not familiar with it yet.

[rlv]

There is probably a clever way to do it using regular expressions, but you can also parse the string as a collection of words:

Sub Test()
    Dim I As Long, J As Long, WCnt As Long
    Dim S As String, WordStr As String, ResultStr As String

    S = "Form 4 Formule 4 CERTIFICATE OF OWNERSHIP CERTIFICAT ENREGISTRE Land Act,S.N. 1981, c. L-1.1, s.63 Loi sur l'enregistrement foncier, L.N.B. de 1981, chap. L-11, art.33 wer  50994121  Owner  Propriétaire"

    ResultStr = ""
    WCnt = WordCount(S, " ")
    For I = 1 To WCnt
        WordStr = ExtractWord(S, " ", I)
        J = Len(WordStr)
        If J >= 7 And J <= 12 And IsNumeric(WordStr) Then
            ResultStr = WordStr
        End If
    Next I

    If ResultStr <> "" Then
        MsgBox "Result = " & ResultStr, , "Test Result"
    Else
        MsgBox "String not found", , "Test Result"
    End If
End Sub

Function ExtractWord(ByVal AnyString As String, ByVal WordDelimiters As String, ByVal WordNumber As Long) As String
    Dim SA() As String
    Dim ResultWord As String

    NormalizeDelimiters AnyString, WordDelimiters    'reduce multiple word delimiters to a single delimiter
    AnyString = CollapseString(AnyString, WordDelimiters)
    SA = Split(AnyString, WordDelimiters)
    If WordNumber > 0 And WordNumber <= UBound(SA) + 1 Then
        ResultWord = SA(WordNumber - 1)
    Else
        ResultWord = vbNullString
    End If
    ExtractWord = ResultWord
End Function


Function WordCount(ByVal AnyString As String, ByVal WordDelimiters As String) As Long
    Dim SA() As String

    NormalizeDelimiters AnyString, WordDelimiters    'reduce multiple word delimiters to a single delimiter
    AnyString = CollapseString(AnyString, WordDelimiters)
    SA = Split(AnyString, WordDelimiters)
    WordCount = UBound(SA) + 1
End Function


'Replace multiple word delmiters with one word delimiter
Sub NormalizeDelimiters(ByRef AnyString As String, ByRef WordDelimiters As String)
    Dim Delimiter As String
    Dim SLen As Long
    Dim I As Long

    SLen = Len(WordDelimiters)
    If SLen > 1 Then
        If InStr(WordDelimiters, Chr(30)) > 0 Then    'preference for space char
            Delimiter = Chr(30)
        Else
            Delimiter = Left(WordDelimiters, 1)
        End If
        For I = 1 To SLen
            AnyString = VBA.Replace(AnyString, Mid(WordDelimiters, I, 1), Delimiter)
        Next I
        WordDelimiters = Delimiter
    End If
End Sub


'Remove multiple delimiters in any string
Function CollapseString(ByVal AnyString As String, ByVal Delimiter As String) As String
    Dim MultiDelims As String
    Dim DCnt As Long    'Delimiter count
    Dim SPos As Long

    For DCnt = 20 To 2 Step -2
        MultiDelims = String(DCnt, Delimiter)
        SPos = InStr(AnyString, MultiDelims)
        If SPos > 0 Then
            AnyString = Replace(AnyString, MultiDelims, Delimiter)
        End If
    Next
    CollapseString = AnyString
End Function

[p45cal]

Another approach might be to find the number between key words as they will always be as below:

"art.33 wer 50994121 Owner Propriétaire"

In that case try:

Sub test()
Dim s As String
s = "Form 4 Formule 4 CERTIFICATE OF OWNERSHIP CERTIFICAT ENREGISTRE Land Act,S.N. 1981, c. L-1.1, s.63 Loi sur l'enregistrement foncier, L.N.B. de 1981, chap. L-11, art.33 wer  50994121  Owner  Propriétaire"
MsgBox GetMyNumber(s)
End Sub

Function GetMyNumber(s)
GetMyNumber = Application.Trim(Split(Split(s, " wer ")(1), " Owner ")(0))
End Function

Or maybe Regex, I have been reading but am just not familiar with it yet.

…another minefield!

[BrI]

Really appreciate the responses - both are working.

p45cal - Your function is very concise - which is great of course, and I get the general idea of how it works. But could you briefly explain what is happening, especially with respect to the indexes (1) and (0). Thanks

[rlv]

At the risk of speaking for p45cal, the Split function returns an array of strings. (0) and (1) refer to specific strings in the zero-based array. Think of it like this:

   String1 = Split(s, " wer ")(1)   
   String2 = Split(String1, " Owner ")(0)  
   GetMyNumber = Application.Trim(String2)

[Paul_Hossler]

Thank you for that.

I tried an approximation of the string I will be using (below) but got a blank message box. Trying to extract the "50994121"

s = "Form 4 Formule 4 CERTIFICATE OF OWNERSHIP CERTIFICAT ENREGISTRE Land Act,S.N. 1981, c. L-1.1, s.63 Loi sur l'enregistrement foncier, L.N.B. de 1981, chap. L-11, art.33 wer  50994121  Owner  Propriétaire"

You didn't say that the number string would be 'stand alone'

The example string helps

If that's always true, then something like this is simpler

Option Explicit
Sub test()
    Dim s As String
    
    s = "Form 4 Formule 4 CERTIFICATE OF OWNERSHIP CERTIFICAT ENREGISTRE Land Act,S.N. 1981, c. L-1.1, s.63 Loi sur l'enregistrement foncier, L.N.B. de 1981, chap. L-11, art.33 wer  50994121  Owner  Propriétaire"
    
    MsgBox ExtractNumbers(s)
     
End Sub
 
 
Function ExtractNumbers(s As String) As String '   could be a Long
    Dim v As Variant
    
    Dim i As Long
     
    v = Split(s, " ")
    
    For i = LBound(v) To UBound(v)
        If Len(v(i)) >= 7 And Len(v(i)) <= 12 And IsNumeric(v(i)) Then
            ExtractNumbers = v(i)
            Exit Function
        End If
    Next I
    
    ExtractNumbers = vbNullString
End Function

[BrI]

Thanks to everyone, solved a number of ways - good to see the options. And explained as well -- great!!

[mdmackillop]

Never answered with a regexp before. This should work if the string is a "word"

Sub test()
Dim strPattern As String
strPattern = "\b[0-9]{7,12}\b"
MsgBox RegxFunc([A1], strPattern)
End Sub


Function RegxFunc(strInput As String, regexPattern As String) As String
    Dim regEx As New RegExp
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = regexPattern
    End With


    If regEx.test(strInput) Then
        Set matches = regEx.Execute(strInput)
        RegxFunc = matches(0).Value
    Else
        RegxFunc = "not matched"
    End If
End Function