Get numbers from cell

[Get Numbers]

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

almJAL_001
almYFI_1020A_1

 

[Mike H]

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

 

[Ron Coderre]

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]

001
1020

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]

That worked, thank you very much

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

 

[Dana DeLouis]

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

 

[Ron Coderre]

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&"0123456789")),
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]

thank you worked perfectly

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