Extract 10 digits number from text or any special characters

[prasadk]

here i have data with text and special characters and 10 digit mobile number in a cell

here i want to extract only 10 digit mobile numbers to separate columns

i need a single formula to extract 10 digit mobile numbers to separate columns

[arnelgp]

create a function in a Module:


Public Function getTenDigits(ByVal pString As Variant) As Variant
Dim ret() As Variant, var As Variant
Dim v As Variant, i As Integer
pString = pString & ""
getTenDigits = Null
If Len(pString) = 0 Then
Exit Function
End If
ReDim ret(20)
With CreateObject("VBScript.RegExp")
.Global = True
.ignorecase = True
.pattern = "[0-9]{10}"
Set var = .Execute(pString)
i = -1
For Each v In var
i = i + 1
ret(i) = v
Next
ReDim Preserve ret(i)
End With
getTenDigits = ret
End Function

to test the function:


Private Sub test()
Dim myNos As Variant, i As Integer
myNos = getTenDigits("asdf 1111111111;9093454980")
If IsArray(myNos) Then
For i = 0 To UBound(myNos)
Debug.Print myNos(i)
Next
End If
End Sub




result:

1111111111
9093454980

or use this function:


Public Function getNumber(ByVal pString As String, ByVal What As String) As String
Dim i As Long, var As Variant
Dim s As String, ret As String
What = LCase(What)
If What <> "phone" And What <> "mobile" Then
Exit Function
End If
var = Split(pString, " ")
For i = 0 To UBound(var)
s = LCase(Trim$(var(i)))
Debug.Print s, What
If (s = What) Or (s = What & ":") Or (s & ":" = What & ":") Or (s & " :" = What & " :") Then
ret = Trim$(var(i + 1))
Exit For
End If
Next
getNumber = ret
End Function

to use:

=getnumber(A2,"mobile")
=getnumber(A2,"phone")

[prasadk]

thank you for given answer to my question
in this three vba code only working one vba code only

that is =getnumber(A2,"mobile")
=getnumber(A2,"phone")

another two vba code or not working correctly