Question : excel vba extract phone & fax in address field

I have a folder of xlsx's & csvs with phone & fax data in an address column that I want to put into their separate phone and fax column.

Ideally, I think the following rules would extract the desired data successfully.

1. Not all numbers pertain to phones (i.e. zipcodes) not all phone numbers are preceeded by anything that identifies it (ie. phone, ph, tel.) not all records have a phone, fax or either.

2. Their are atleast 10+ consecutive numbers in a phone (with international codes & dialing can be 13-15 numbers) which might have a few of any of the following separators [.],[-],[)],[(] or A single space[ ].

3. The first occurance of the strand of numbers as described in #2 is the phone #, the second occurance is the fax #.

I allready managed to run a script on a folder of files. I just noticed that it will be unsustainable for me to go into the records one by one and manually extract the phone and fax #'s since there are many.

Answer : excel vba extract phone & fax in address field

Try the following:

It uses user functions.

Chris

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:



Function fnValNum(strInput As String) As Boolean
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As Object
    
    Set regEx = CreateObject("vbscript.regexp")
    regEx.IgnoreCase = True
    regEx.Pattern = "([0-9][-.() ]*){10,15}"
    fnValNum = regEx.test(strInput) = True
    
Set regEx = Nothing
End Function

Function fnGetNum(strInput As String, telNum As Boolean) As String
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As Object
Dim colMatch As Object
Dim itm As Variant
    
    If fnValNum(strInput) Then
        Set regEx = CreateObject("vbscript.regexp")
        regEx.IgnoreCase = True
        regEx.Global = True
        regEx.Pattern = "([0-9][-.() ]*){10,15}"
        Set colMatch = regEx.Execute(strInput)
        If telNum Then
            fnGetNum = colMatch(0)
        Else
            If colMatch.Count > 1 Then _
                fnGetNum = colMatch(1)
        End If
    End If
    
Set regEx = Nothing
End Function

sample-data-1-.xls (34 KB) (File Type Details)

code established in supplied file