VBA-Extract only number from a string

[malleshg24]

[QUOTE]

Hi Team,


From below data i want to extract only number to the adjacent cell.
Can you suggest a macro for this.

A	B
ASDF4554	4554
ASD45548	?
789SDFE54	?
ASD89467	?
WERWE4897	?
JLKJ4545WER	?
7879FLDS	?
QWE897JVNL	?
LJKL789SDF	?

Thanks in advance !!

Regards,
Mallesh.

[LutonBarry]

No need for a macro. Paste the formula below into cell B2 and it will extract the numbers only from the cells.

=SUMPRODUCT(MID(0&A2,LARGE(INDEX(ISNUMBER(--MID(A2,ROW($1:$25),1))* ROW($1:$25),0),ROW($1:$25))+1,1)*10^ROW($1:$25)/10)

By the way, if you have an entry in a cell like "swes3454gfr56" it will return 345456.

[SamT]

Standard Module Code:

Public Function OnlyNumbers(Cel As Range) As Long 
'Will not work with decimals
'Will only Return first set of numbers. Ie 123ABC456 will return 123
'For Help, see: http://www.vbaexpress.com/forum/showthread.php?61763

Dim Str as String
Dim Num As String

Str = Cel.text

Do while Len(Str) >= 1
If IsNumeric Left(Str, 1) then Num = Num & Left(Str, 1)
If (Len(Num) > 0) And (Not IsNumeric(Left(Str, 1))) then Exit Do
If Len(Str) = 1 Then Exit Do
Str = Mid(Str, 2)
Loop

OnlyNumbers = CLng(Num)
End Function

B2 Formula = "=OnlyNumbers(A2)". Fill down

[offthelip]

if you want all the numerals then this will do it for you,to use it
B2 Formula = "=getnumerals (A2)" then fill down

Function getnumerals(tt As Variant)

ott = ""
For i = 1 To Len(tt)
ntt = Mid(tt, i, 1)


If IsNumeric(ntt) Then
 ott = ott & ntt
End If
Next i
getnumerals = ott
End Function

[yujin]

OK. Here's a way using regular expression.

Sub test()
    Dim i As Long, r As Long
    Dim match
    Dim numbers As String
    
    For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        With CreateObject("VBScript.RegExp")
            .Pattern = "\d+"
            .Global = True
            Set match = .Execute(Cells(r, 1))
            
            If match.Count > 0 Then
                numbers = ""
                For i = 0 To match.Count - 1
                   numbers = numbers & match(i)
                Next i
                Cells(r, 2) = numbers
            End If
        End With
    Next r
End Sub