Sometimes you may need to pull the numbers from alphanumeric strings in your worksheet cells. The user defined function (UDF), I’m presenting here, separates numbers from a cell containing numbers and text characters. The referenced cell can contain any string, including spaces, decimal points or negative numbers.
Function PullNum(rng As
Range, _
Optional Point As Boolean, Optional Negat As Boolean) As Double
'Pulls a number from a cell containing alphanumerics
'e.g. =PullNum(A1,,TRUE) pulls negative number
Dim cnt As Integer, i As Integer, sLen As Integer
Dim sTxt As String, sMinus As String, sDP As String, sN As String
Dim sV As Variant
sTxt = rng
If Point = True And Negat = True Then
sMinus = "-": sDP = "."
ElseIf Point = True And Negat = False Then
sMinus = vbNullString: sDP = "."
ElseIf Point = False And Negat = True Then
sMinus = "-": sDP = vbNullString
End If
sLen = Len(sTxt)
For cnt = sLen To 1 Step -1
sV = Mid(sTxt, cnt, 1)
If IsNumeric(sV) Or sV = sMinus Or sV = sDP Then
i = i + 1
sN = Mid(sTxt, cnt, 1) & sN
If IsNumeric(sN) Then
If CDbl(sN) < 0 Then Exit For
Else
sN = Replace(sN, Left(sN, 1), "", , 1)
End If
End If
If i = 1 And sN <> vbNullString Then sN = CDbl(Mid(sN, 1, 1))
Next cnt
PullNum = CDbl(sN)
End Function
Optional Point As Boolean, Optional Negat As Boolean) As Double
'Pulls a number from a cell containing alphanumerics
'e.g. =PullNum(A1,,TRUE) pulls negative number
Dim cnt As Integer, i As Integer, sLen As Integer
Dim sTxt As String, sMinus As String, sDP As String, sN As String
Dim sV As Variant
sTxt = rng
If Point = True And Negat = True Then
sMinus = "-": sDP = "."
ElseIf Point = True And Negat = False Then
sMinus = vbNullString: sDP = "."
ElseIf Point = False And Negat = True Then
sMinus = "-": sDP = vbNullString
End If
sLen = Len(sTxt)
For cnt = sLen To 1 Step -1
sV = Mid(sTxt, cnt, 1)
If IsNumeric(sV) Or sV = sMinus Or sV = sDP Then
i = i + 1
sN = Mid(sTxt, cnt, 1) & sN
If IsNumeric(sN) Then
If CDbl(sN) < 0 Then Exit For
Else
sN = Replace(sN, Left(sN, 1), "", , 1)
End If
End If
If i = 1 And sN <> vbNullString Then sN = CDbl(Mid(sN, 1, 1))
Next cnt
PullNum = CDbl(sN)
End Function
To use the function, copy its code to any of the Modules in your workbook (add a Module, if not included yet in the workbook). The function can be used in several formats, depending on your optional needs, e.g.:
=pullnum(A1)
=pullnum(A1,TRUE)
=pullnum(A1,TRUE,TRUE)
=pullnum(A1,,TRUE)
=pullnum(A1,FALSE,TRUE)
=pullnum(A1,TRUE)
=pullnum(A1,TRUE,TRUE)
=pullnum(A1,,TRUE)
=pullnum(A1,FALSE,TRUE)
Here are some examples of output obtained with the function:
No comments:
Post a Comment
All comments are held for moderation. I reserve the right to edit, censor, delete and - if necessary - block comments.