Pulling complicated numbers.

Ingolf

Banned
Joined
Mar 20, 2011
Messages
809
Hello,


In cell A1 are several phrases containing words and numbers. The numbers are separated by words, less the ten numbers which are consecutive and separated by commas.
How can I extract the numbers of those phrases. One of numbers have 13 digits, one has 7 digits and one or more 10-digit numbers that start with 0 (zero). I would like to extract those numbers in separate columns, except ten-digit numbers, I want in the same cell separated by commas.
In the same phrase it is also an email address that I want to draw it in a separate column.

In cell A2...A10 it is other phrases with same pattern.
One number with 13 digits
One number with 7 digits
One or more numbers (starting with Zero) separated by commas.
Email address

Need a VBA code.
Thank you.
 
Last edited:

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

FDibbins

Well-known Member
Joined
Feb 16, 2013
Messages
6,723
I doubt we have many mind readers in today, so giving some samples of what you are working with, would probably help a lot ;)
 

Ingolf

Banned
Joined
Mar 20, 2011
Messages
809
Thank you FDibbins for replay,

Let say in A1:

Sadfsadf sdfsadf, saf 1145748745127 asdasd dfg. Daadadfd sdfasfdsaf 0155214542, 0994578452, 0114115887 sfsf sgsgb etwrtw, sdfawerw 1234567 dfg. Wasda sdfsf drres.dust@gmail.com aasdas.

In A2 other phrases bat same pattern and only 2 numbers instead of 3 (ten-Digits number)

Thanks.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows
Guessing at your data structure (Ford is correct... examples would have been useful), I came up with this macro...
Code:
Sub RetrieveNumbers()
  Dim X As Long, Cell As Range, CellText As String, Parts() As String
  For Each Cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
    CellText = Cell.Value
    For X = 1 To Len(CellText)
      If Mid(CellText, X, 1) Like "[!0-9]" Then Mid(CellText, X) = " "
    Next
    Cell.Offset(, 1).Resize(, 3).NumberFormat = "@"
    Cell.Offset(, 1).Resize(, 3) = Split(Replace(Application.Trim(CellText), " ", ","), ",", 3)
  Next
End Sub
 

Ingolf

Banned
Joined
Mar 20, 2011
Messages
809

ADVERTISEMENT

Rick, thanks for the reply.

The code is OK but not extracted email address.
I forgot to mention that in some cells (but not all) I have something like DA555MNT (2 letters, three digits and three letters, all uppercase) that I want extract in a separate cell.

the email address could be dawson.mike25@gmail.com
Thank you.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows
I forgot to mention that in some cells (but not all) I have something like DA555MNT (2 letters, three digits and three letters, all uppercase) that I want extract in a separate cell.
Okay, I think now would be a good time to post some representative samples of your data so we can see exactly what they look like, but more importantly, the layout of all the data you want retrieved with respect to each other.
 

Ingolf

Banned
Joined
Mar 20, 2011
Messages
809

ADVERTISEMENT

Sorry, we have not noticed all the right item for extraction.
The data in column A look like this:

Sadfsadf sdfsadf, saf 1145748745127 asdasd DFG. Daadadfd sdfasfdsaf 0155214542, and 0994578452, and this 0114115887 sfsf sgsgb etwrtw, sdfawerw 1234567 dfg. Aasdf sdfgsd AV364ZAQ dads. Wasdale sdfsf drres.dust@gmail.com aasdas.

Some cells do not have the phrase highlighted in red.
I want to extract

in B2 to F2
13 digits number | email address______| 10 digits (one or more) _____________|AV364ZAQ | 7 digits number
1145748745127 |drres.dust@gmail.com |0155214542, 0994578452, 0114115887 |AV364ZAQ |1234567

If a cell in column A is not something that BB980KTY (2 uppercase letters, three numbers and three uppercase) then that cell in column E will remain empty.

Thank you very much.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows
Sorry, we have not noticed all the right item for extraction.
The data in column A look like this:

Sadfsadf sdfsadf, saf 1145748745127 asdasd DFG. Daadadfd sdfasfdsaf 0155214542, and 0994578452, and this 0114115887 sfsf sgsgb etwrtw, sdfawerw 1234567 dfg. Aasdf sdfgsd AV364ZAQ dads. Wasdale sdfsf drres.dust@gmail.com aasdas.

Some cells do not have the phrase highlighted in red.
I want to extract

in B2 to F2
13 digits number | email address______| 10 digits (one or more) _____________|AV364ZAQ | 7 digits number
1145748745127 |drres.dust@gmail.com |0155214542, 0994578452, 0114115887 |AV364ZAQ |1234567

If a cell in column A is not something that BB980KTY (2 uppercase letters, three numbers and three uppercase) then that cell in column E will remain empty.
It is so much easier to write code when we can see the data for ourselves rather than relying on a written description (you data look nothing like I imagined from your original message). Depending on punctuation marks you may have in the cells that you have not shown us, this code appears to work...
Code:
Sub RetrieveNumbers()
  Dim X As Long, Cell As Range, Result As Variant, Parts() As String
  For Each Cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
    Parts = Split(Replace(Cell.Value, ",", ""))
    ReDim Result(1 To 1, 1 To 5)
    For X = 0 To UBound(Parts)
      If Parts(X) Like "#############" Then
        Result(1, 1) = Parts(X)
      ElseIf Parts(X) Like "##########" Then
        Result(1, 3) = Result(1, 3) & ", " & Parts(X)
      ElseIf Parts(X) Like "#######" Then
        Result(1, 5) = Parts(X)
      ElseIf Parts(X) Like "*@*" Then
        Result(1, 2) = Parts(X)
      ElseIf Parts(X) Like "[A-Z][A-Z]###[A-Z][A-Z][A-Z]" Then
        Result(1, 4) = Parts(X)
      End If
    Next
    Result(1, 3) = Mid(Result(1, 3), 3)
    Cell.Offset(, 1).Resize(, 5) = Result
  Next
End Sub
 

Ingolf

Banned
Joined
Mar 20, 2011
Messages
809
Yes Rick, you're right.

Content of cell A2:

Excel Workbook
ABCDEF
1*13 Digits NumberEmailPhone Number 10 digits number7 Digits NumberIndicator
2Concern is led by DL. JAMIE BROWN, whose account 1550101223356. Contact phone number is 0155214542, 0994578452, 0114115887. PROVIDER THINGS IS FREE TRADE SC, number 1122334, with BJ545RTY indicator. For additional information using the email address drres26.dust@gmail.com1550101223356drres26.dust@gmail.com0155214542, 0994578452, 01141158871122334BJ545RTY
Sheet1


Thanks for your patience and understanding.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,675
Office Version
  1. 2010
Platform
  1. Windows
Yes Rick, you're right.

Content of cell A2:

Excel Workbook
ABCDEF
1*13 Digits NumberEmailPhone Number 10 digits number7 Digits NumberIndicator
2Concern is led by DL. JAMIE BROWN, whose account 1550101223356. Contact phone number is 0155214542, 0994578452, 0114115887. PROVIDER THINGS IS FREE TRADE SC, number 1122334, with BJ545RTY indicator. For additional information using the email address drres26.dust@gmail.com1550101223356drres26.dust@gmail.com0155214542, 0994578452, 01141158871122334BJ545RTY
Sheet1


Thanks for your patience and understanding.
I did say "depending on punctuation marks"... originally, I accounted only for the comma next to some of your numbers, but you have decimal points (which must be recognized as being different from the dots in the email address). I believe the following code correctly handles the various text combination it appears you can have...
Code:
Sub RetrieveNumbers()
  Dim X As Long, Cell As Range, CellText As String, Result As Variant, Parts() As String
  For Each Cell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
    CellText = Cell.Value
    For X = 1 To Len(Cell.Value) - 1
      If Mid(CellText, X, 2) Like "#[!0-9A-Z ]" Then Mid(CellText, X + 1) = " "
    Next
    Parts = Split(Application.Trim(CellText))
    ReDim Result(1 To 1, 1 To 5)
    For X = 0 To UBound(Parts)
      If Parts(X) Like "#############" Then
        Result(1, 1) = Parts(X)
      ElseIf Parts(X) Like "##########" Then
        Result(1, 3) = Result(1, 3) & ", " & Parts(X)
      ElseIf Parts(X) Like "#######" Then
        Result(1, 5) = Parts(X)
      ElseIf Parts(X) Like "*@*" Then
        Result(1, 2) = Parts(X)
      ElseIf Parts(X) Like "[A-Z][A-Z]###[A-Z][A-Z][A-Z]" Then
        Result(1, 4) = Parts(X)
      End If
    Next
    Result(1, 3) = Mid(Result(1, 3), 3)
    Cell.Offset(, 1).Resize(, 5).NumberFormat = "@"
    Cell.Offset(, 1).Resize(, 5) = Result
  Next
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,418
Messages
5,596,028
Members
414,039
Latest member
southike

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
Top