Extract Consecutive Digits from a String using VBA

Question

I've written a sub that extracts all the digits from a string in cell A1 and pastes the result in cell A2. This loops through each row repeating the process until all cells containing strings have been worked through.

However, I would like to only extract the numbers that are consecutive (more than 1 digit)

for example: from this string: string-pattern-7---62378250-stringpattern.html I only want to extract the digits 62378250 and not the preceding 7.

How should I alter my code to achieve this?

Option Explicit

Function onlyDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function


Sub extractDigits()

Dim myStr As String

Do While ActiveCell.Value <> Empty
        myStr = onlyDigits(ActiveCell.Value)
        ActiveCell(1, 2).Value = myStr
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub

Answer 1

This is fairly similar to the excellent answer of @Gary'sStudent but has a slightly different structure:

Function ConsecutiveDigits(s As String) As String
    'returns the first substring consisting of 2 or more
    'consecutive digits which is delimited by either a
    'nondigit or the edge of the string
    'returns empty string if no such subtring exists

    Dim i As Long
    Dim c As String
    Dim digits As String

    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        If IsNumeric(c) Then
            digits = digits & c
        Else
            If Len(digits) > 1 Then
                ConsecutiveDigits = digits
                Exit Function
            Else
                digits = "" 'reset
            End If
        End If
    Next i
    'we are at the end of the string -- should we return digits?
    If Len(digits) > 1 Then ConsecutiveDigits = digits
    'else return default empty string

End Function

Answer 2

Think this should do it if you only have one sequence

Function onlyDigits(v As Variant) As String

With CreateObject("vbscript.regexp")
    .Pattern = "\d{2,}"
    If .Test(v) Then onlyDigits = .Execute(v)(0)
End With

End Function

Answer 3

Consider:

Public Function onlyDigits(s As String) As String
    Dim L As Long, s2 As String, i As Long, Kapture As Boolean
    Dim CH As String, temp As String

    s2 = s & " "
    L = Len(s2)
    Kapture = False
    temp = ""
    onlyDigits = ""

    For i = 1 To L
        CH = Mid(s2, i, 1)
        If IsNumeric(CH) Then
            temp = temp & CH
            If Len(temp) > 1 Then Kapture = True
        Else
            If Len(temp) < 2 Then
                temp = ""
            Else
                If Kapture Then
                    Exit For
                End If
            End If
        End If
    Next i

    If Kapture Then onlyDigits = temp
End Function