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
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
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

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With