Extracting string of 10 Numbers from cell

de_keda

New Member
Joined
May 22, 2015
Messages
8
I have a column of thousands of cells that contain responses from a survey. Each cell contains an account number (or should) of exactly 10 numbers, but at different positions in the cell. The cell can also contain other numbers, but I need to extract just the 10-digit account number from each cell to another cell.

Example(1):
aa9876 reviewed 1234567891 and proceeded to credit $10

Example(2):
2345678912 completed

Example(3):
$50 credit. 3456789123 done. 3ab456 approved

Because this is a survey-type response, the user can enter anything they wish and submit it. But each response *should* contain the 10-digit account number.

I found and slightly modified the following CSE array formula (though I don't really understand it), but it only returns the first 10 numbers in the cell; as the account number is not always the first thing entered, it does not help:
=LEFT(SUM(MID(0&C31,LARGE(ISNUMBER(--MID(C31,ROW(INDIRECT("1:"&LEN(C31))),1))*ROW(INDIRECT("1:"&LEN(C31))),ROW(INDIRECT("1:"&LEN(C31))))+1,1)*10^ROW(INDIRECT("1:"&LEN(C31)))/10),10)

I need a formula that will search for the string of the 10-digit account number and return only that number, regardless of what other text/numbers are in the cell.

Thanks in advance!!!
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
de_keda,

You have asked for formula solution, but, none of the formula Guru's have responded yet.

Here is a Worksheet_Change Event for you to consider that will work in Range C2:C10000. You can change the C10000 to a larger number if you need to.

I assume that you have a title in cell C1.

Sample worksheet:


Excel 2007
CD
1Survey Response
2
3
4
5
6
7
8
Sheet1


And, after entering in information we get this:


Excel 2007
CD
1Survey Response
2aa9876 reviewed 1234567891 and proceeded to credit $101234567891
32345678912 completed2345678912
4$50 credit. 3456789123 done. 3ab456 approved3456789123
51234567890 finished1234567890
61234567890 done1234567890
7123456789 completed
8
Sheet1


I see that I made a mistake in the last entry in cell C7, so, I edit the cell and add one more digit, and we get this:


Excel 2007
CD
1Survey Response
2aa9876 reviewed 1234567891 and proceeded to credit $101234567891
32345678912 completed2345678912
4$50 credit. 3456789123 done. 3ab456 approved3456789123
51234567890 finished1234567890
61234567890 done1234567890
71234567891 completed1234567891
8
Sheet1


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor
4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
5. Press the keys ALT + Q to exit the Editor, and return to Excel

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 11/17/2016, ME976552
Dim s, i As Long
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  If Len(Target) = 10 And IsNumeric(Target) Then
    Target.Offset(, 1).Value = Target.Value
  Else
    If InStr(Target, " ") Then
      s = Split(Target, " ")
      For i = LBound(s) To UBound(s)
        If Len(s(i)) = 10 And IsNumeric(s(i)) Then
          Target.Offset(, 1).Value = s(i)
          .Columns(4).AutoFit
          GoTo MyExit
        End If
      Next i
    End If
  End If
MyExit:
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub


Before you use the above code with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then make entries in range C2:C10000.
 
Last edited:
Upvote 0
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
' hiker95, 11/17/2016, ME976552
Dim s, i As Long
If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
With Application
  .EnableEvents = False
  .ScreenUpdating = False
  If Len(Target) = 10 And IsNumeric(Target) Then
    Target.Offset(, 1).Value = Target.Value
  Else
    If InStr(Target, " ") Then
      s = Split(Target, " ")
      For i = LBound(s) To UBound(s)
        If Len(s(i)) = 10 And IsNumeric(s(i)) Then
          Target.Offset(, 1).Value = s(i)
          .Columns(4).AutoFit
          GoTo MyExit
        End If
      Next i
    End If
  End If
MyExit:
  .EnableEvents = True
  .ScreenUpdating = True
End With
End Sub
I seriously doubt this will be a problem for the OP, but your code can be fooled...

$50 credit. Code: 120000d300 done. 1234567890 approved
 
Upvote 0
I seriously doubt this will be a problem for the OP, but your code can be fooled...

$50 credit. Code: 120000d300 done. 1234567890 approved
This modification to your code will work even with entries like above...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  ' hiker95, 11/17/2016, ME976552
  Dim s As Variant, i As Long
  If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target = "" Then Target.Offset(, 1).ClearContents: Exit Sub
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    s = Split(Target, " ")
    For i = 0 To UBound(s)
      If s(i) Like "##########" Then
        Target.Offset(, 1).NumberFormat = "General"
        Target.Offset(, 1).Value = s(i)
        .Columns(4).AutoFit
        GoTo MyExit
      End If
    Next i
MyExit:
    .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub
 
Last edited:
Upvote 0
Try this formula way,

In B2, formula copy down :

=LOOKUP(9.9E+307,--MID(A2,ROW(INDIRECT("1:"&LEN(A2)-10)),11))

Regards
Bosco
 
Upvote 0
This modification to your code will work even with entries like above...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  ' hiker95, 11/17/2016, ME976552
  Dim s As Variant, i As Long
  If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target = "" Then Target.Offset(, 1).ClearContents: Exit Sub
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    s = Split(Target, " ")
    For i = 0 To UBound(s)
      If s(i) Like "##########" Then
        Target.Offset(, 1).NumberFormat = "General"
        Target.Offset(, 1).Value = s(i)
        .Columns(4).AutoFit
        GoTo MyExit
      End If
    Next i
MyExit:
    .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub

Rick Rothstein,

Nicely done, and, thanks. (y)
 
Upvote 0
Try this formula way,

In B2, formula copy down :

=LOOKUP(9.9E+307,--MID(A2,ROW(INDIRECT("1:"&LEN(A2)-10)),11))

Regards
Bosco

Not of high probability, but does it work if the number to be extracted is followed by 12345678e1 or 12345678912 or 12-11-2016?
 
Last edited:
Upvote 0
@hiker95, @Rick Rothstein:

The code still can be fooled into producing false negatives with
entries like "aa9876 reviewed 1234567891, proceeded to credit $10".

This might be a problem for the OP.

So, perhaps '... Like "*##########*"...' then extracting the number?
 
Upvote 0
@hiker95, @Rick Rothstein:

The code still can be fooled into producing false negatives with
entries like "aa9876 reviewed 1234567891, proceeded to credit $10".

This might be a problem for the OP.
Ah, yes, punctuation marks. I think this modification to the original modification I made to hiker95's code will fix this problem...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  ' hiker95, 11/17/2016, ME976552
  Dim s As Variant, i As Long, x As Long
  If Intersect(Target, Range("C2:C10000")) Is Nothing Then Exit Sub
  If Target.Count > 1 Then Exit Sub
  If Target = "" Then Target.Offset(, 1).ClearContents: Exit Sub
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    s = Split(Target, " ")
    For i = 0 To UBound(s)
      For x = 1 To Len(s(i))
        If Mid(s(i), x, 1) Like "[!A-Za-z0-9]" Then Mid(s(i), x) = " "
      Next
      If Trim(s(i)) Like "##########" Then
        Target.Offset(, 1).NumberFormat = "General"
        Target.Offset(, 1).Value = s(i)
        .Columns(4).AutoFit
        GoTo MyExit
      End If
    Next i
MyExit:
    .EnableEvents = True
    .ScreenUpdating = True
  End With
End Sub
 
Upvote 0
Ah, yes, punctuation marks. I think this modification to the original modification I made to hiker95's code will fix this problem...

Yes it will. But in terms of efficiency, it will unnecessarily "clean"
every element of the Split -- even those that do not have 10 digits.

I would also replace 'GoTo MyExit' with 'Exit For'.
 
Upvote 0

Forum statistics

Threads
1,216,225
Messages
6,129,599
Members
449,520
Latest member
TBFrieds

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