Pulling complicated numbers.

Ingolf

Banned
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.

Need a VBA code.
Thank you.

Last edited:

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use \$ signs: \$V\$2:\$Z\$99 will always point to V2:Z99, even after copying
I doubt we have many mind readers in today, so giving some samples of what you are working with, would probably help a lot

Thank you FDibbins for replay,

Let say in A1:

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

Thanks.

Last edited:
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``````

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:
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.

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

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:
Sorry, we have not noticed all the right item for extraction.
The data in column A look like this:

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``````

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:
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``````

Replies
1
Views
461
Replies
6
Views
487
Replies
3
Views
712
Replies
4
Views
362
Replies
3
Views
231

1,221,008
Messages
6,157,357
Members
451,416
Latest member
Ilu

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.

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

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