Extract phone numbers from comments
- I have a column with comments in it (over 5000 cases).
- These comments have text, numbers, date, everything.
- I need to get the phone number from these comments.
- Phone numbers are in random places for each comment, so
LEFT
,MID
orRIGHT
won't work
The closest result I have achieved is with Kutools =EXTRAXTNUMBERS()
...... but I am getting a string of numbers that includes date, id, etc.
Prefers formula. :)
Below are two examples of comments required phone numbers: bold
Thursday, February 2, 2017 14:37 Coordinating Universal Time .3868 67076939 , pers. Parv Tatiana Selected Result: Noruna citā laikā - 2017-02-03 07:15 Wednesday 8 February 2017 8:18 UTC .3868 nr. 67074071 -neeksistē, personāla daļas vad. Tatjana neatbild, arīnr. 67076600 Selective Result: Neceļ Friday, February 10, 2017 7:15 UTC * .3868 *** piezv ap 13 Selective Result: Noruna citā laikā - 2017-02-10 11:15
Thursday 2 February 2017 11:15 AM Coordinated Universal Time 4213 zvanīt 66119908 Selected Result: Noruna citā laikā - 2017-02-07 09:00 14 February 2017 12:59 PM Coordinated Universal Time .4532 * anita @dzintarniece @rtp .lv Selected Result: Turpināt internetā
source to share
This little UDF () will return all 8-digit numeric substrings in a string:
Public Function PHNum(s As String) As String
Dim L As Long, i As Long, temp As String
Dim CH As String
L = Len(s)
temp = ""
PHNum = ""
For i = 1 To L
CH = Mid(s, i, 1)
If IsNumeric(CH) Then
temp = temp & CH
If Len(temp) = 8 Then
PHNum = PHNum & vbCrLf & temp
End If
Else
temp = ""
End If
Next i
End Function
Note:
To get a complex format in the output cell, format it for hyphenation.
source to share
Regexp Solution
This UDF extracts you phone numbers from text as an array. You can end up using Join
to convert it to a csv string, or you can insert an array into a range of cells.
Function extractPhones(s As String) As String()
Dim i As Long, matches, match, ret
With CreateObject("VBScript.Regexp")
.Global = True
.Pattern = "\W[26]\d{7}\W"
Set matches = .Execute(s)
End With
ReDim ret(1 To matches.Count) As String
For Each match In matches
i = i + 1
ret(i) = Mid(match, 2, Len(match) - 2)
Next
extractPhones = ret
End Function
It uses a regular expression that matches a phone number with these specs:
- - this is exactly 8 digits
- start with 6 or 2
- not preceded or followed by an alphanumeric letter, but spaces or punctuation characters.
source to share
Using UDF, you can accomplish this using the following code:
To use it:
- Click on
ALT + F11
- Insert module
- Paste code
- In an Excel Worksheet, use this formula
=get_phone("CELL_WITH_NUMBER_HERE")
to get the first 8-digit sequence in your cell.
Code:
Public Function get_phone(cell As Range)
Dim s As String
Dim i As Integer
Dim num
Dim counter As Integer
'get cell value
s = cell.Value
'set the counter
counter = 0
'loop through the entire string
For i = 1 To Len(s)
'check to see if the character is a numeric one
If IsNumeric(Mid(s, i, 1)) = True Then
'add it to the number
num = num + Mid(s, i, 1)
counter = counter + 1
'check if we've reached 8 digits
If counter = 8 Then
get_phone = num
Exit Function
End If
Else
'was not numeric so reset counter and answer
counter = 0
num = ""
End If
Next i
End Function
Image example:
source to share
Another regexp that returns everything matches one cell
See https://regex101.com/r/Hdv65h/1
Function StrPhone(strIn As String) As String
Dim objRegexp As Object
Set objRegexp = CreateObject("VBScript.Regexp")
With objRegexp
.Global = True
.Pattern = ".*?(\d{8})|.*$"
StrPhone = Trim(.Replace(strIn, "$1 "))
End With
End Function
source to share
Excel has an add-in that I have used in the past for regular expressions ( http://seotoolsforexcel.com/regexpfind/ ). This can be tricky in your case, since you don't know how many times a phone number will appear in your cell. In these cases, I suggest you use VBA scripts that have been provided by other users.
source to share