Extract Only Numbers (VB Function)

Visual Basic Modules Add comments

Here's a Visual Basic function I wrote called extractOnlyNumbers which returns the numeric only parts of a string. For example, extractOnlyNumbers("123a4") would return 1234 (as a double). If you decide to pass it the second parameter (stop_at_non_numeric), then it will stop processing when it reaches a non-numeric character so extractOnlyNumbers("123a4") would return 123 (as a double). This second parameter is optional, if you don't pass it then it will process all characters.

Download extractOnlyNumbers.bas (May 31, 2006)

MSDN Links
 Mid Function Reference
 VarType Function Reference

Public Function extractOnlyNumbers(v As Variant, Optional stop_at_non_numeric As Boolean) As Double
 On Error Goto extractNumsError
 Dim strOutput As String
 If CStr(v) = "" Or v = Null Or VarType(v) = vbNull Then 'if nothing was passed
  extractOnlyNumbers = 0
  Exit Function
 End If
 Dim i As Integer
 For i = 1 To Len(CStr(v))
 If Mid(CStr(v), i, 1) >= "0" And Mid(CStr(v), i, 1) <= "9" Then
  strOutput = strOutput & Mid(CStr(v), i, 1)
 Else
  If stop_at_non_numeric = True Then
   extractOnlyNumbers = CDbl(strOutput)
   Exit Function
  End If
 End If
 Next i
 extractOnlyNumbers = CDbl(strOutput)
 Exit Function
 extractNumsError:
 If Err.Number = 6 Then 'overflow Error
  MsgBox "The number you have passed To extractOnlyNumbers() is too large.", vbCritical + vbOKOnly, "Error - " & App.Title
 Else
  MsgBox "An Error has occured..." & vbLf & vbLf & "Error Number: " & Err.Number & vbLf & "Error Description: " & Err.Description & vbLf, vbCritical + vbOKOnly
 End If
 extractOnlyNumbers = 0 'default to 0 In Case of Error
End Function

2 Responses to “Extract Only Numbers (VB Function)”

  1. Kevin Ritch says:

    Here's another approach:

    Function MyNum(S As String) As Double
     For i = 1 To Len(S)
      N = N & IIf(InStr("1234567890", Mid$(S, i, 1)), Mid$(S, i, 1),  "")
     Next i
     MyNum = Val(N)
    End Function
    
  2. steve0 says:

    This is what I use...

    Function x(ByVal s$) As Double
     Dim i As Long
     Dim sTmp$
     For i = 1 To Len(s$)
      If IsNumeric(Mid(s$, i, 1)) Then
       sTmp$ = sTmp$ & Mid(s$, i, 1)
      End If
     Next
     x = Val(sTmp$)
    End Function
    

Leave a Comment

Entries RSS Comments RSS Log in