Results 1 to 5 of 5

Thread: VBA-Extract only number from a string

  1. #1

    VBA-Extract only number from a string


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


  2. #2
    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.

  3. #3
    Moderator VBAX Wizard SamT's Avatar
    Oct 2006
    Near Columbia
    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:
    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)
    OnlyNumbers = CLng(Num)
    End Function
    B2 Formula = "=OnlyNumbers(A2)". Fill down
    Please take the time to read the Forum FAQ

  4. #4
    VBAX Expert
    May 2016
    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

  5. #5
    VBAX Regular
    Jan 2018
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts