Get numbers from cell
 

I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

hi,

Because your numbers and text are mixed then this may do whay you require.
Right click the sheet tab, view code and paste this in:-

Sub extractnumbers()
Dim RegExp As Object, Collection As Object, RegMatch As Object
Dim Myrange As Range, C As Range, Outstring As String
Set RegExp = CreateObject("vbscript.RegExp")
With RegExp
.Global = True
.Pattern = "\d"
End With
Set Myrange = ActiveSheet.Range("a1:a100") 'change to suit
For Each C In Myrange
Outstring = ""
Set Collection = RegExp.Execute(C.Value)
For Each RegMatch In Collection
Outstring = Outstring & RegMatch
Next
C.Offset(0, 1) = Outstring
Next
Set Collection = Nothing
Set RegExp = Nothing
Set Myrange = Nothing
End Sub


Mike

"Get Numbers" wrote:

I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

In addition to the source values:
almJAL_001
almYFI_1020A_1

Can you let us know what the end result should be?
001? or...1?
1020? or...1020A1? or....10201?
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"Get Numbers" <Get wrote in message
...
I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

001
1020

"Ron Coderre" wrote:

In addition to the source values:
almJAL_001
almYFI_1020A_1

Can you let us know what the end result should be?
001? or...1?
1020? or...1020A1? or....10201?
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"Get Numbers" <Get wrote in message
...
I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

That worked, thank you very much

"Mike H" wrote:

hi,

Because your numbers and text are mixed then this may do whay you require.
Right click the sheet tab, view code and paste this in:-

Sub extractnumbers()
Dim RegExp As Object, Collection As Object, RegMatch As Object
Dim Myrange As Range, C As Range, Outstring As String
Set RegExp = CreateObject("vbscript.RegExp")
With RegExp
.Global = True
.Pattern = "\d"
End With
Set Myrange = ActiveSheet.Range("a1:a100") 'change to suit
For Each C In Myrange
Outstring = ""
Set Collection = RegExp.Execute(C.Value)
For Each RegMatch In Collection
Outstring = Outstring & RegMatch
Next
C.Offset(0, 1) = Outstring
Next
Set Collection = Nothing
Set RegExp = Nothing
Set Myrange = Nothing
End Sub


Mike

"Get Numbers" wrote:

I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

001
1020

Hi. Same idea as Mike's, but this idea only returns the first set of
numbers, and converts the number 1 (001) to a string to keep it the string
001.
This works on a Selection.

Sub FirstNumbersOnly()
Dim RegExp As Object
Dim Numbers As Object
Dim Cell As Range
Dim PreChar As String 'Force String

Set RegExp = CreateObject("Vbscript.RegExp")
PreChar = Chr(39)

With RegExp
.Global = True
.Pattern = "\d+"

For Each Cell In Selection.Cells
If .Test(Cell.Value) Then
Set Numbers = .Execute(Cell.Value)
Cell(1, 2) = PreChar & Numbers(0)
Else
Cell(1, 2) = vbNullString
End If
Next Cell
End With
Set Numbers = Nothing
Set RegExp = Nothing
End Sub

--
Dana DeLouis


"Get Numbers" wrote in message
...
001
1020

"Ron Coderre" wrote:

In addition to the source values:
almJAL_001
almYFI_1020A_1

Can you let us know what the end result should be?
001? or...1?
1020? or...1020A1? or....10201?
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"Get Numbers" <Get wrote in message
...
I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

If formulas are acceptable....
With A1 containing the source text

Try this ARRAY FORMULA
(commited with CTRL+SHIFT+ENTER,instead of just ENTER),
in 2 sections for readability.

B1: =MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"01234 56789")),
MAX(MATCH(FALSE,ISNUMBER(--MID(A1,8+ROW($1:$20)-1,1)),0)-1,1))

Is that something you can work with?
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"Get Numbers" wrote in message
...
001
1020

"Ron Coderre" wrote:

In addition to the source values:
almJAL_001
almYFI_1020A_1

Can you let us know what the end result should be?
001? or...1?
1020? or...1020A1? or....10201?
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"Get Numbers" <Get wrote in message
...
I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1

Get numbers from cell
 

thank you worked perfectly

"Dana DeLouis" wrote:

001
1020

Hi. Same idea as Mike's, but this idea only returns the first set of
numbers, and converts the number 1 (001) to a string to keep it the string
001.
This works on a Selection.

Sub FirstNumbersOnly()
Dim RegExp As Object
Dim Numbers As Object
Dim Cell As Range
Dim PreChar As String 'Force String

Set RegExp = CreateObject("Vbscript.RegExp")
PreChar = Chr(39)

With RegExp
.Global = True
.Pattern = "\d+"

For Each Cell In Selection.Cells
If .Test(Cell.Value) Then
Set Numbers = .Execute(Cell.Value)
Cell(1, 2) = PreChar & Numbers(0)
Else
Cell(1, 2) = vbNullString
End If
Next Cell
End With
Set Numbers = Nothing
Set RegExp = Nothing
End Sub

--
Dana DeLouis


"Get Numbers" wrote in message
...
001
1020

"Ron Coderre" wrote:

In addition to the source values:
almJAL_001
almYFI_1020A_1

Can you let us know what the end result should be?
001? or...1?
1020? or...1020A1? or....10201?
--------------------------

Regards,

Ron
Microsoft MVP (Excel)
(XL2003, Win XP)

"Get Numbers" <Get wrote in message
...
I need to extract the numbers from a given cell to an adjacent cell.
Examples of cell values below.

almJAL_001
almYFI_1020A_1