PDA

View Full Version : VBA-Extract only number from a string



malleshg24
01-13-2018, 01:43 PM
Hi Team,


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

[QUOTE]

A
B


ASDF4554
4554


ASD45548
?


789SDFE54
?


ASD89467
?


WERWE4897
?


JLKJ4545WER
?


7879FLDS
?


QWE897JVNL
?


LJKL789SDF
?





Thanks in advance !!

Regards,
Mallesh.

LutonBarry
01-13-2018, 02:30 PM
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
01-13-2018, 02:37 PM
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
01-13-2018, 04:56 PM
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
01-13-2018, 08:32 PM
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