extractNumbers.vba

Sub extractNumbersFromCells()
'
'
' Extract numbers from cells in selected range
'
Dim rng As Range
Dim Last As Long
    Last = ActiveSheet.UsedRange.Rows.Count

    For Each rng In Selection
        If rng.Row > Last Then Exit For
        If rng.Value <> "" And Not rng.Value Like "q*" Then                                                     'note use of wildcard here
            rng.Value = ExtractNumber(rng, False, False)                                                         'function has a lot more capabilities than what I'm using it for here
        End If
        
    Next rng
    
End Sub
'______________________________________________________________________________________________________
Function ExtractNumber(rCell As Range, Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double

    

Dim iCount As Integer, i As Integer, iLoop As Integer

    Dim sText As String, strNeg As String, strDec As String

    Dim lNum As String

    Dim vVal, vVal2

     

     ''''''''''''''''''''''''''''''''''''''''''

     'Written by OzGrid Business Applications

     'www.ozgrid.com

     'Extracts a number from a cell containing text and numbers.

     ''''''''''''''''''''''''''''''''''''''''''

    sText = rCell

    If Take_decimal = True And Take_negative = True Then

        strNeg = "-" 'Negative Sign MUST be before 1st number.

        strDec = "."

    ElseIf Take_decimal = True And Take_negative = False Then

        strNeg = vbNullString

        strDec = "."

    ElseIf Take_decimal = False And Take_negative = True Then

        strNeg = "-"

        strDec = vbNullString

    End If

    iLoop = Len(sText)

        

            For iCount = iLoop To 1 Step -1

            vVal = Mid(sText, iCount, 1)

            

    

                If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then

                    i = i + 1

                    lNum = Mid(sText, iCount, 1) & lNum

                        If IsNumeric(lNum) Then

                            If CDbl(lNum) < 0 Then Exit For

                        Else

                          lNum = Replace(lNum, Left(lNum, 1), "", , 1)

                        End If
                End If


                If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))

            Next iCount

    ExtractNumber = CDbl(lNum)

End Function