UDF to extract phone numbers from cell content

satish78

Board Regular
Joined
Aug 31, 2014
Messages
218
Hi Friends.

I have list of customer information in excel cell ColumnA like list of 1000 customers.
I want to extract all phone numbers present in each cell data. But phone numbers formats are different in each cell like

201.337.3900 or 213373900 or 1213373900 or 1(201 337-3900 or (201) 337.3900 or 201 337-3900 or 201 337-3900 or 201 337 3900 or 201-337-3900 or 201.337.3900 or 1201-337-3900 etc.

I think this is only possible with UDF.
I did search on posts related to udf and vba but not exact solution I found.

Satish
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

Book1
AB
1Phone: 201.337.3900(201) 337-3900
2Phone: 213373900
3Phone: 1213373900(121) 337-3900
4Phone: 1(201 337-3900(201) 337-3900
5Phone: (201) 337.3900(201) 337-3900
6Phone: 201 337-3900(201) 337-3900
7Phone: 201 337-3900(201) 337-3900
8Phone: 201 337 3900(201) 337-3900
9Phone: 201-337-3900(201) 337-3900
10Phone: 201.337.3900(201) 337-3900
11Phone: 1201-337-3900(201) 337-3900
Sheet1
Cell Formulas
RangeFormula
B1=GetPhoneNumberFromText(A1)


Code:
Private regex As Object
Public Function GetPhoneNumberFromText(inputString As String) As String

Dim matches As Object

' Set default value - blank in this case but could be "Not Found" or similar
GetPhoneNumberFromText = ""

' Set up the regular expression first time around
If regex Is Nothing Then
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\(?([0-9]{3})\)?[-. ]?([0-9]{3})[-. ]?([0-9]{4})"
    regex.Global = True
End If

' Get the matches
Set matches = regex.Execute(inputString)

' Quit if we can't find a number
If matches.Count = 0 Then Exit Function

' Just process the first match
GetPhoneNumberFromText = regex.Replace(matches(0).Value, "($1) $2-$3")

End Function

It doesn't like your second and third examples though ...

WBD
 
Upvote 0
some phone numbers are also like this +14015232592. in this udf is removing last digit 2 and result is (140) 152-3259.



AB
Phone: 201.337.3900(201) 337-3900
Phone: 213373900
Phone: 1213373900(121) 337-3900
Phone: 1(201 337-3900(201) 337-3900
Phone: (201) 337.3900(201) 337-3900
Phone: 201 337-3900(201) 337-3900
Phone: 201 337-3900(201) 337-3900
Phone: 201 337 3900(201) 337-3900
Phone: 201-337-3900(201) 337-3900
Phone: 201.337.3900(201) 337-3900
Phone: 1201-337-3900(201) 337-3900

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: center"]5[/TD]

[TD="align: center"]6[/TD]

[TD="align: center"]7[/TD]

[TD="align: center"]8[/TD]

[TD="align: center"]9[/TD]

[TD="align: center"]10[/TD]

[TD="align: center"]11[/TD]

</tbody>
Sheet1

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]B1[/TH]
[TD="align: left"]=GetPhoneNumberFromText(A1)[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]



Code:
Private regex As Object
Public Function GetPhoneNumberFromText(inputString As String) As String

Dim matches As Object

' Set default value - blank in this case but could be "Not Found" or similar
GetPhoneNumberFromText = ""

' Set up the regular expression first time around
If regex Is Nothing Then
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\(?([0-9]{3})\)?[-. ]?([0-9]{3})[-. ]?([0-9]{4})"
    regex.Global = True
End If

' Get the matches
Set matches = regex.Execute(inputString)

' Quit if we can't find a number
If matches.Count = 0 Then Exit Function

' Just process the first match
GetPhoneNumberFromText = regex.Replace(matches(0).Value, "($1) $2-$3")

End Function

It doesn't like your second and third examples though ...

WBD
 
Upvote 0
Try changing the pattern to this:

Code:
    regex.Pattern = "(?:\+1)?(?:\+[0-9])?\(?([0-9]{3})\)?[-. ]?([0-9]{3})[-. ]?([0-9]{4})"

Note that you may need to press Ctrl+G and force the regex object to reset like this:

Code:
Set regex = Nothing

WBD
 
Upvote 0
I do have another similar one but with vlookup its taking hours of time.

just like above

I have content in cell from which i need to extract state abbreviation or state name, if possible city as well.
I need udf to extract state name or abbreviation in Sheet1 columnB

example:

sheet1A Content contains state abbreviation or state name after name of person.
In sheet2 ColumnA we have state names and abbreviations in columnb.
here is sample file https://docs.google.com/spreadsheets/d/1Qw0CaBUP1Qo0uaXRO-jlKdT6wJu5xfhrs84QGBzFlLs/edit?usp=sharing


Try changing the pattern to this:

Code:
    regex.Pattern = "(?:\+1)?(?:\+[0-9])?\(?([0-9]{3})\)?[-. ]?([0-9]{3})[-. ]?([0-9]{4})"

Note that you may need to press Ctrl+G and force the regex object to reset like this:

Code:
Set regex = Nothing

WBD
 
Last edited:
Upvote 0
Is there a better way to extract country codes as well or instead of extract below format, I need the script to extract all phone numbers, either 10, 11,12,13,14,15,16 etc digits including space or without space after country code.

AB
Phone: 201.337.3900(201) 337-3900
Phone: 213373900
Phone: 1213373900(121) 337-3900
Phone: 1(201 337-3900(201) 337-3900
Phone: (201) 337.3900(201) 337-3900
Phone: 201 337-3900(201) 337-3900
Phone: 201 337-3900(201) 337-3900
Phone: 201 337 3900(201) 337-3900
Phone: 201-337-3900(201) 337-3900
Phone: 201.337.3900(201) 337-3900
Phone: 1201-337-3900(201) 337-3900

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: center"]5[/TD]

[TD="align: center"]6[/TD]

[TD="align: center"]7[/TD]

[TD="align: center"]8[/TD]

[TD="align: center"]9[/TD]

[TD="align: center"]10[/TD]

[TD="align: center"]11[/TD]

</tbody>
Sheet1

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=DAE7F5]#DAE7F5[/URL] "]B1[/TH]
[TD="align: left"]=GetPhoneNumberFromText(A1)[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]



Code:
Private regex As Object
Public Function GetPhoneNumberFromText(inputString As String) As String

Dim matches As Object

' Set default value - blank in this case but could be "Not Found" or similar
GetPhoneNumberFromText = ""

' Set up the regular expression first time around
If regex Is Nothing Then
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "\(?([0-9]{3})\)?[-. ]?([0-9]{3})[-. ]?([0-9]{4})"
    regex.Global = True
End If

' Get the matches
Set matches = regex.Execute(inputString)

' Quit if we can't find a number
If matches.Count = 0 Then Exit Function

' Just process the first match
GetPhoneNumberFromText = regex.Replace(matches(0).Value, "($1) $2-$3")

End Function

It doesn't like your second and third examples though ...

WBD
 
Upvote 0
I am concentrating USA phone numbers only. So, people use 1 or +1 or 1(area code) or +1(area code) or area code only to identify there phone/mobile numbers.
Hope you understand.

it is far better
Is there a better way to extract country codes as well or instead of extract below format, I need the script to extract all phone numbers, either 10, 11,12,13,14,15,16 etc digits including space or without space after country code.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,189
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top