Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement