extract 10 digit number from cell

MatthewLane412

New Member
Joined
Aug 23, 2017
Messages
24
In my excel file I have column AK. Each cell is filled with strings. These strings contain numeric and non numeric information. An example of a string is "house 7410145689 October 2018". The stings always contain different information. Sometimes they contain a 10 digit number and sometimes they don't. The 10 digit number can move to different places in the string. My End goal is for the column to be left with nothing but either a blank cell or a 10 digit string. Currently I came up with some code that has a 97 percent success rate by using a combination of inStr with replace, code that deletes all non numeric characters, and code that clears the contents of cells that are less than 10 digits. I Found the following code online but I'm having trouble implementing it for Column AK (or at all). So far I have added on Tools -->References-->Microsoft VBScript Regular Expressions 5.5. Any help would be greatly appreciated. Thank you,Matt


Code:
Function Extract(S As String) As String 
Dim RE As New RegExp
Dim MyMatches As MatchCollection
Dim MyMatch As Match

RE.pattern = "(?:^|[^0-9]) ([0-9]{10})(?:[^0-9]|$)"
Set MyMatches = RE.Execute(S)
If MyMatches.Count = 0 Then
Extract ""
Else 
Set MyMatch=MyMatches(0)
Extract=MyMatch.SubMatches(0)
End If

End Function
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hi

With the values in column A try this code.
I wrote the results in column B for testing.


Code:
Sub test()
Dim r As Range, rC As Range

Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each rC In r
    rC.Offset(, 1) = Extract10(rC.Value)
Next rC
End Sub


Function Extract10(S As String) As String
Dim regex As RegExp

Set regex = New RegExp
regex.Pattern = "(^|\D)\d{10}(?!\d)"
With regex.Execute(S)
    If .Count > 0 Then Extract10 = .Item(0)
End With
End Function


<table border="1" cellpadding="1" style="background:#FFF; border-collapse:collapse;border-width:2px;border-color:#CCCCCC;font-family:Arial,Arial; font-size:10pt" ><tr><th style="border-width:1px;border-color:#888888;background:#9CF " > </th><th style="border-width:1px;border-color:#888888;background:#9CF; text-align:center" >A</th><th style="border-width:1px;border-color:#888888;background:#9CF; text-align:center" >B</th><th style="border-width:1px;border-color:#888888;background:#9CF; text-align:center" width=30 >C</th></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>1</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>2</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>3</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">house 7410145689 October 2019</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; ">7410145689</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>4</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">house 741014568 October 2020</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>5</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">7410145689 house October 2019</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; ">7410145689</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>6</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">house October 7410145689 2019</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; ">7410145689</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>7</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:left;border-width: 1px;border-color:#888888; ">house October 2019 7410145689</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; ">7410145689</td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>8</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;background:#9CF; text-align:center; " ><b>9</b></td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td><td style="border-width:1px;border-color:#000000; padding-left:0.5em; padding-top:0.4em; padding-right:0.5em; padding-bottom:0.25em;text-align:right;border-width: 1px;border-color:#888888; "> </td></tr><tr><td colspan=4 style="background:#9CF; padding-left:1em" > [Book1]Sheet1</td></tr></table>
 
Upvote 0
The code worked wonderfully. Thank you very much.


Hi

With the values in column A try this code.
I wrote the results in column B for testing.


Code:
Sub test()
Dim r As Range, rC As Range

Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each rC In r
    rC.Offset(, 1) = Extract10(rC.Value)
Next rC
End Sub


Function Extract10(S As String) As String
Dim regex As RegExp

Set regex = New RegExp
regex.Pattern = "(^|\D)\d{10}(?!\d)"
With regex.Execute(S)
    If .Count > 0 Then Extract10 = .Item(0)
End With
End Function


[TABLE="width: 2"]
<tbody>[TR]
[TH] [/TH]
[TH="align: center"]A[/TH]
[TH="align: center"]B[/TH]
[TH="width: 30, align: center"]C[/TH]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: left"]house 7410145689 October 2019[/TD]
[TD="align: right"]7410145689[/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: left"]house 741014568 October 2020[/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: left"]7410145689 house October 2019[/TD]
[TD="align: right"]7410145689[/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: left"]house October 7410145689 2019[/TD]
[TD="align: right"]7410145689[/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: left"]house October 2019 7410145689[/TD]
[TD="align: right"]7410145689[/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[TD="align: right"] [/TD]
[/TR]
[TR]
[TD="colspan: 4"] [Book1]Sheet1[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
For those who might be interested, here is a version of the Extract10 function which does not use Regular Expressions (hence, no reference to Microsoft VBScript Regular Expressions 5.5 is required)...
Code:
Function Extract10(S As String) As String
  Dim X As Long
  For X = 1 To Len(S) + 1
    If Mid("X" & S & "X", X, 12) Like "[!0-9]##########[!0-9]" Then
      Extract10 = Mid(S, X, 10)
      Exit Function
    End If
  Next
End Function
 
Upvote 0
Hi

For the solution in post #2 , in case you don't want to set the reference to Microsoft VBScript Regular Expressions,

replace

Code:
Dim regex As RegExp

Set regex = New RegExp

Code:
Dim regex As Object

Set regex = creatobject("VBScript.RegExp")
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,180
Members
452,615
Latest member
bogeys2birdies

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