VBA: Extract Number From String
The following function will extract the numerical portion from a string:
Function Extract_Number_from_Text(Phrase As String) As Double
Dim Length_of_String As Integer
Dim Current_Pos As Integer
Dim Temp As String
Length_of_String = Len(Phrase)
Temp = ""
For Current_Pos = 1 To Length_of_String
If (Mid(Phrase, Current_Pos, 1) = "-") Then
Temp = Temp & Mid(Phrase, Current_Pos, 1)
End If
If (Mid(Phrase, Current_Pos, 1) = ".") Then
Temp = Temp & Mid(Phrase, Current_Pos, 1)
End If
If (IsNumeric(Mid(Phrase, Current_Pos, 1))) = True Then
Temp = Temp & Mid(Phrase, Current_Pos, 1)
End If
Next Current_Pos
If Len(Temp) = 0 Then
Extract_Number_from_Text = 0
Else
Extract_Number_from_Text = CDbl(Temp)
End If
End Function
So for example:
Extract_Number_from_Text(“uuigguo 995”) will return 995
Extract_Number_from_Text(“uuigguo 0.12995”) will return 0.12995
Extract_Number_from_Text(“yu00.000456”) will return 0.000456
=Extract_Number_from_Text(“juii-0009.9987iihiii”) will return -0.9987
If there is no number in the phrase then a zero is returned.
To download the .XLSM file from this article, click here.
**IF** the user’s locale uses a **dot** for the decimal point, then here is a much shorter function to do this…
Function Extract_Number_from_Text(Phrase As String) As Double
Dim X As Long, SubString As String
For X = 1 To Len(Phrase)
Extract_Number_from_Text = Val(Mid(Phrase, X))
If Extract_Number_from_Text Then Exit For
Next
End Function
I don’t do “non-US locale” programming, so I’m not sure how to deal with non-dot decimal pointed numbers, but perhaps the comma could be replace with a dot inside the Mid function call (although I’m not sure what the Val function will return if you do that).
You have juste to replace the comma by a dot so you have to do a Replace(“Phrase” , “,” , “.”) i think that this should work
Function StN(ByVal SwS As String) As Long ”’EXTRACT NUMBER FROM STRING
Dim i As Long
StN = 0
If Len(SwS) Then
For i = 1 To Len(SwS)
If Val(Mid$(SwS, i)) 0 Then
StN = Val(Mid$(SwS, i))
Exit For
End If
Next
End If
End Function