EXTRACTNUMBERS

Returns only the numbers from a text string.

Remarks

* For instructions on how to add a function to a workbook refer to the page under Inserting Functions
* The equivalent JavaScript function is EXTRACTNUMBERS

concatenates all the numbers in a string 'iNumberIndex - which number to return if there is more than one 'IncludeDecimals - will include a decimal place in the concatenation 'IncludeNegatives - will include the last minus sign (before numbers) in the the concatenation Function

sText - 
iNumberIndex - 
bIncludeDecimals - 
bIncludeNegatives - 

ExtractNumbers(ByVal sText As String, _ 
               Optional ByVal iNumberIndex As Integer = 1, _ 
               Optional ByVal IncludeDecimals As Boolean = False, _ 
               Optional ByVal IncludeNegatives As Boolean = False) As Variant 

Dim iCount As Integer 
Dim iCountNumbers As Integer 
Dim iCountPosition As Integer 
Dim sChar As String 
Dim sChar_Decimal As String 
Dim sChar_Negative As String 
Dim sNumbers As String 

    sChar_Decimal = vbNullString 
    If (IncludeDecimals = True) Then sChar_Decimal = "." 

    sChar_Negative = vbNullString 
    If (IncludeNegatives = True) Then sChar_Negative = "-" 

    iCountPosition = 1 
    For iCount = 1 To Len(sText) 
        sChar = Left(sText, 1) 
        sText = Right(sText, Len(sText) - 1) 
        
        If ((IsNumeric(sChar)) Or _ 
            (sChar = sChar_Negative) Or _ 
            (sChar = sChar_Decimal)) Then 
                        
            iCountNumbers = iCountNumbers + 1 
            
            If (sChar <> sChar_Negative) Then 
                sNumbers = sNumbers & sChar 
            Else 
                If (Len(sNumbers) = 0) Then 
                    sNumbers = sNumbers & sChar 
                End If 
            End If 
            
            If ((IsNumeric(sNumbers) = True) And (sChar <> sChar_Negative)) Then 
                If (CDbl(sNumbers) < 0) Then 
                    Exit For 
                End If 
            End If 
        Else 
            If ((Len(sNumbers) > 0) And _ 
               ((sNumbers <> sChar_Negative) And (sNumbers <> sChar_Decimal))) Then 
                If (iCountPosition = iNumberIndex) Then 
                    Exit For 
                Else 
                    sNumbers = "" 
                    iCountPosition = iCountPosition + 1 
                End If 
            Else 
                sNumbers = "" 
            End If 
        End If 
        If ((iCountNumbers = 1) And (sNumbers <> vbNullString)) Then 
            sNumbers = Mid(sNumbers, 1, 1) 
        End If 
    Next iCount 
    If (Len(sNumbers) = 0) Then ExtractNumbers = "#N/A" 
    If (Len(sNumbers) > 0) Then ExtractNumbers = CDbl(sNumbers) End Function 

Public Sub Testing_ExtractNumbers() 

'    Debug.Print ExtractNumbers("A889.5D-A1234-E", 1)             '889
'    Debug.Print ExtractNumbers("A889.5D-A1234-E", 1, True)       '889.5
'    Debug.Print ExtractNumbers("A889.5D-A1234-E", 1, True, True) '889.5

    Debug.Print ExtractNumbers("A889.5D-A1234-E", 2)             '5  
    Debug.Print ExtractNumbers("A889.5D-A1234-E", 2, True)       '1234  
    Debug.Print ExtractNumbers("A889.5D-A1234-E", 2, True, True) '1234  
    Debug.Print ExtractNumbers("A889.5D-A1234-E", 2, False, True) 
    
'    Debug.Print ExtractNumbers("A889.5D-A1234-E", 3)
'    Debug.Print ExtractNumbers("A889.5D-A1234-E", 3, True)
'    Debug.Print ExtractNumbers("A889.5D-A1234-E", 3, True, True)
    
End Sub