UDF to extract phone numbers from cell content

S

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

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes

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.



wideboydixon said:
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
Click to expand...
 
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


wideboydixon said:
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
Click to expand...
 
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.

wideboydixon said:
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
Click to expand...
 
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
satish78 said:
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.
Click to expand...
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Extracting a specific number of characters from a multiline cell
Replies
7
Views
377
etaf
etaf
S
  • Question Question
Create New Sheet with Specific Name Based on Variable Cell
Replies
0
Views
242
SBExcel123
S
W
  • Question Question
VBA to Copy Excel cells (one at a time) text to Windows Clipboard so that the text can be Pasted into another application using Windows+V
Replies
3
Views
291
WFCompany
W
A
  • Solved
Excel VBA Phone Number Format Issue
Replies
4
Views
413
AnnAnn
A
J
  • Question Question
Extract list of cells from one column in to one cell and separate by a comma
Replies
8
Views
158
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

Share this page

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