Extract multiple numeric value sets

I found an extremely useful VBA code for extracting numeric values from a cell IF and ONLY IF there is only one set of numbers looking to be extracted. However, in my case there are times where I need to extract multiple numeric values, but I'm not sure how to tweak the current code. Any thoughts?

Below is an example of what my worst case scenario would look like. At the end of the day all I need are the 9 digit numeric value after the "RID". However, one problem is "RID" is not always present in these comments in addition if possible I'd like to exclude dates. Not sure if this is plausible or not, but thought I'd ask anyways.

[TABLE="width: 813"]

[TD="class: xl64, align: left"]RID: 576233191; RID: 576372763;RID: 576372769;RID: 576372770;RID: 576372774;RID: 576372776;RID: 576372779;RID: 576372782; Please have this process shut down as it is a duplicate. The sale date has been changed from 6/23/16 to 8/4/16. This change occurred because an IRS lien was discovered and proper notices needed to be sent in order to be in compliance with the judgment order. Please have all rails/processes that were auto launched off the 6/23/16 sale date removed/closed. The NTRID are mentioned above. Thank you[/TD]

[/TABLE]

Option Explicit


Function ExtractNumber(rCell As Range, _
     Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double




    




Dim iCount As Integer, i As Integer, iLoop As Integer
    Dim sText As String, strNeg As String, strDec As String
    Dim lNum As String
    Dim vVal, vVal2




     ''''''''''''''''''''''''''''''''''''''''''
     'Written by OzGrid Business Applications
     'www.ozgrid.com
     'Extracts a number from a cell containing text and numbers.




     ''''''''''''''''''''''''''''''''''''''''''




    sText = rCell
    
    If Take_decimal = True And Take_negative = True Then
        strNeg = "-" 'Negative Sign MUST be before 1st number.
        strDec = "."
    ElseIf Take_decimal = True And Take_negative = False Then
        strNeg = vbNullString
        strDec = "."
    ElseIf Take_decimal = False And Take_negative = True Then
        strNeg = "-"
        strDec = vbNullString
    End If




    iLoop = Len(sText)




            For iCount = iLoop To 1 Step -1
            vVal = Mid(sText, iCount, 1)
                If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then
                    i = i + 1
                    lNum = Mid(sText, iCount, 1) & lNum
                        If IsNumeric(lNum) Then
                            If CDbl(lNum) < 0 Then Exit For
                        Else
                          lNum = Replace(lNum, Left(lNum, 1), "", , 1)
                        End If
                End If
                If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))
            Next iCount
    ExtractNumber = CDbl(lNum)
     




End Function

Re: Extract multiple numeric value sets

HOLY COW! Not only was that possibly the quickest reply I've seen it does work 100%!!!

Quote from skywriter;773008

You can try this. :cool:

Code

Function GetNineNumbers(cell As Range)
Dim tStr As String
Dim regex As Object
Dim m As Object, j As Object
If cell.Cells.Count > 1 Then
    GetNineNumbers = "Pick only 1 cell."
    Exit Function
End If
Set regex = CreateObject("VBScript.RegExp")
With regex
    .Pattern = "\b\d{9}\b"
    .Global = True
    If .test(cell) Then
        Set m = .Execute(cell)
            For Each j In m
                tStr = Trim(tStr) & " " & j & ","
            Next j
        tStr = Left(tStr, (Len(tStr) - 1))
    Else
        GetNineNumbers = "No matches."
        Exit Function
    End If
End With
    GetNineNumbers = tStr
End Function

Display More