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

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



© 2019 Better Solutions Limited. All Rights Reserved. © 2019 Better Solutions Limited TopPrevNext