Using Microsoft Excel VBA to extract phone numbers

Question

I am trying to extract phone numbers from Columns A:E, and place them in Columns F:I. "The provided example is an instance on Col"E"".

I would like the phone numbers extracted to Columns F:I. However, if a column already has data. Then move onto the next, using that last "I" Column as the final location should the data have 4 numbers "It will never be greater than 4"

Dim c As Range, i As Integer
For Each c In Worksheets("data").Range("B2", _
Worksheets("data").Range("B" & Rows.Count).End(xlUp))
With c
  If .Value2 Like "*???-???-????*" Then
    For i = 11 To 14
      If .Offset(, i).Value2 = "" Then
        .Offset(, i).Value2 = .Value2
        .Value2 = ""
        GoTo NextC
      End If
    Next i
  End If
End With
NextC:
  Next c
End sub

The problem I am having is it only returns some of the phone numbers and not all of them. "98k rows"

The data is from an old XML file that I extracted. On a specific "Name" column from the extraction, I had replaced the carriage return code with a unique symbol, I then used that unique symbol to run a text to columns. It provided key "Name" data from A:N. {example: Customer names, email address, cell phones, home phone, item details, street address, city, zip...} Now each one of those columns could very well hold phone number data that I would like extracted in 4 separate columns "most likley F:I", but also keeping the logic that as the phone columns fill up, it doesnt overwrite and moves on to the next available column from the 4 I designated.

changed If .Value2 Like "*???-???-????*" Then to If .text Like "*###-###-####*" Then

Success.

See [How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops](http://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops/22542835#22542835) or search for *[vba][regex]phone number* — , Jun 24 '16 at 05:39
Help us by showing samples of your data - and examples of what formats are displayed (Value) and stored (Value2) - your seacrhing on Value2 - but if all your numbers are displayed the same maybe you need to compare Value or Text properties? — dbmitch, Jun 24 '16 at 05:44
I figured .value2 would eliminate the possibility of acquiring a date or currency. (https://msdn.microsoft.com/en-us/library/office/ff193553.aspx) — , Jun 24 '16 at 05:50
Not quite; the [Range.Value2 property](https://msdn.microsoft.com/en-us/library/office/ff193553.aspx) will strip regional information from a date value essentially turning it into a long integer, currency becomes a double. — , Jun 24 '16 at 05:52
.value nor .text were any help either. I copy the data that doesn't get extracted to another worksheet. I set the scenario up the same and it works with .value2 — , Jun 24 '16 at 06:10
Is there any reason to split the original with the [Range.TextToColumns method](https://msdn.microsoft.com/en-us/library/office/ff193593.aspx) other than trying to ease the parsing of phone numbers? — , Jun 24 '16 at 06:34
Because that is all I am familiar with. Rookie on the VBA side but really enjoy learning more about it. — , Jun 24 '16 at 15:05

score 2 · Answer 1 · answered Jun 24 '16 at 07:06

2

This should get you started towards a regular expression (aka regex) solution.

Option Explicit

Sub ewqre()
    Dim str As String, n As Long, rw As Long
    Dim rgx As Object, cmat As Object, ws As Worksheet

    Set rgx = CreateObject("VBScript.RegExp")
    Set ws = Worksheets("Sheet2")

    With rgx
        .Global = True
        .MultiLine = True
        'phone number pattern is: ###-###-####
        .Pattern = "[0-9,\-]{12}"
        For rw = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
            str = ws.Cells(rw, "A").Value2
            If .Test(str) Then
                Set cmat = .Execute(str)
                'populate the worksheet with the matches
                For n = 0 To cmat.Count - 1
                    ws.Cells(rw, Columns.Count).End(xlToLeft).Offset(0, 1) = cmat.Item(n)
                Next n
            End If
        Next rw
    End With

    Set rgx = Nothing: Set ws = Nothing

End Sub

answered Jun 24 '16 at 07:06

I receive a Type mismatch error on: `str = ws.Cells(rw, "A").Value2` – Jun 24 '16 at 15:12
Did you change `Set ws = Worksheets("Sheet2")` to the right worksheet? – Jun 24 '16 at 15:19
Yes, I made sure the worksheet name matched, both were "Sandbox". I also checked the MS VBScript 5.5 box in tools/refs. – Jun 24 '16 at 15:27
... and what is the value of `rw` when you enter debug? – Jun 24 '16 at 15:29
By hovering over 'str' I get the value of "349+40 sc belt" Can I guess that the "+" is where I am having these issues? – Jun 24 '16 at 15:34
Sounds like it. Use [.Text](https://msdn.microsoft.com/en-us/library/office/ff840217.aspx) instead of [.Value2](https://msdn.microsoft.com/en-us/library/office/ff193553.aspx) (although I would gthink that .Value2 *should* pick up the cell's text). – Jun 24 '16 at 15:38
I did try switching .value2 to .value and .text Both were unsuccessful. So I did a find/replace of the + and now the bug is on "Zylberg" its a last name – Jun 24 '16 at 15:39
The bug on that name was due to errors directly below it. I removed all of the errors (#name #value!) and the program ran but there were 0 numbers extracted. – Jun 24 '16 at 15:46
Consider posting redacted sample data to a public upload site and put the publicly accessible link back here. – Jun 24 '16 at 15:54
The funny thing is, when I produce pseudo data. It works. For some reason the data I extracted from XML isnt playing so nice. – Jun 24 '16 at 16:14

Using Microsoft Excel VBA to extract phone numbers

1 Answers1