Extract data from a text row

[donlincolnmre2]

Hello

I have a sheet that contains data in column B with text and phone numbers.

I’m looking to extract the phone numbers from column B and place it, in a BLANK ROW UNDER in column A and then delete that number from column B and then copy the row which had the number right next to the phone number where the number was placed, AS SHOWN IN THE FOLLOWING Google sheet link.

Extract Phone Numbers

Sheet1 To Process (334) 329-7100,2101 E University Dr. Auburn, AL 36830-3334. ... Bakersfield, CA 93312-3209. 661-589-4400. Drywall. (209) 408-8466,Vega, Ceres (CA) • Age: 48, , 3600 ... 831-722-4757,Arredondo:, Watsonville CA, 334 Buena Vista Dr ... 661-951-0808,P.O. BOX 1995 LANCASTER, CA 93...

docs.google.com

Any help will be greatly appreciated J

Thanks.

 

[Peter_SSs]

AS SHOWN IN THE FOLLOWING Google sheet link.

Is this a Google Sheets question or Excel?

If Excel on Windows OS, try this macro with a copy of your workbook.

Sub ExtractPhone()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = " \d{3}\-\d{3}\-\d{4}"
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a) * 2, 1 To 2)
  For i = 1 To UBound(a)
    k = k + 1
    b(k, 1) = a(i, 1)
    If RX.Test(a(i, 2)) Then
      b(k, 2) = RX.Replace(a(i, 2), " ")
      k = k + 1
      b(k, 1) = Mid(RX.Execute(a(i, 2))(0), 2)
      b(k, 2) = b(k - 1, 2)
    Else
      b(k, 2) = a(i, 2)
    End If
  Next i
  Range("D2:E2").Resize(k).Value = b
End Sub

If it is a Google Sheets question then post back to say so and then I can move the thread to the correct forum.

 

[donlincolnmre2]

This was the Excel question and i run the macro that you gave me, it worked great.!!!

The only thing i noticed that some times the number format changed and those numbers of course weren't extract, here is the format.

Assessor P.O. Box 1255, Weaverville, CA 96093 Phone Fax (530)623-8398 Email assessor@trinitycounty.org.
2101 E University Dr. Auburn, AL 36830-3334. ... Bakersfield, CA 93312-3209. (661) 589-4400. Bill's Drywall.

In the first one the ) are collapsed right next to the number and in 2nd format the area code as ( ) around them.

Is there is any way to modify the macro to check for those two formats and extracts those numbers also.

Thanks.

 

[donlincolnmre2]

I was able to find a work around it, i searched for ( and replaced with nothing and then searched for ) and space and replaced with - and then the macro picked up that format and was able to extract the other 2 numbers.

Again thanks for all your help.

 

[Peter_SSs]

Glad you got a solution.

Without those Find/Replace processes, you could have used the blue modified pattern line below

However, this would extract the numbers just as they were in the original data. Perhaps you prefer to have all the numbers in a standard format and if you wanted the code to do that for you, you could make the second blue line change too.

Sub ExtractPhone_v2()
  Dim RX As Object
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Pattern = " \(?\d{3}[\) \-]{1,2}\d{3}\-\d{4}"
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value2
  ReDim b(1 To UBound(a) * 2, 1 To 2)
  For i = 1 To UBound(a)
    k = k + 1
    b(k, 1) = a(i, 1)
    If RX.Test(a(i, 2)) Then
      b(k, 2) = RX.Replace(a(i, 2), " ")
      k = k + 1
      b(k, 1) = Replace(Application.Trim(Replace(Replace(RX.Execute(a(i, 2))(0), "(", " "), ")", " ")), " ", "-")
      b(k, 2) = b(k - 1, 2)
    Else
      b(k, 2) = a(i, 2)
    End If
  Next i
  Range("D2:E2").Resize(k).Value = b
End Sub

 

[donlincolnmre2]

I will check it out.

Thanks for all your help

 

[Peter_SSs]

No problem. Glad to help.