View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming,microsoft.public.excel.worksheetfunctions
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default Extract Part of Sentence for Separate Cell's Value

Perhaps a bit shorter:

==============================
Option Explicit
Function ParseVal(rg As Range)
Dim objRe As Object
Dim colMatches As Object
Const Pattern As String = "\$([0-9,.]+)"

Set objRe = CreateObject("vbscript.regexp")
objRe.Global = True
objRe.Pattern = Pattern

If objRe.Test(rg.Text) = True Then
Set colMatches = objRe.Execute(rg.Text)
ParseVal = CDbl(colMatches(0))
Else
ParseVal = ""
End If

End Function
============================


On 26 Dec 2006 09:26:45 -0800, "Ben" wrote:

See function below to return value. Just call it by putting the formula
"=extractedvalue(c13)" in an empty cell.

Function ExtractedValue(SubjectText As Variant)

Dim CurrSymbol As String
CurrSymbol = "$"
Dim x, y, z As Integer
Dim Exists, IsValue As Boolean
Dim IntegerText As String
Dim FractionText As String
Dim IntegerPart As Variant
Dim FractionPart As Variant

IntegerText = ""

'check CurrSymbol exists in the phrase, if not exit with error
message
Exists = False
For x = 1 To Len(SubjectText)
If Mid(SubjectText, x, 1) = CurrSymbol Then
Exists = True
Else
End If
Next x
If Exists = False Then
ExtractedValue = CurrSymbol & " Not Found"
Exit Function
Else
End If

'find the first occurance of currsymbol
x = 1
While Mid(SubjectText, x, 1) < CurrSymbol
x = x + 1
Wend

'throw away the first bit
For y = x + 1 To Len(SubjectText)
IntegerText = IntegerText & Mid(SubjectText, y, 1)
Next y

'walk throught the IntegerText untile we run our of numbers.

IsValue = True
x = 1
While IsValue = True
If _
Mid(IntegerText, x, 1) = 0 Or _
Mid(IntegerText, x, 1) = 1 Or _
Mid(IntegerText, x, 1) = 2 Or _
Mid(IntegerText, x, 1) = 3 Or _
Mid(IntegerText, x, 1) = 4 Or _
Mid(IntegerText, x, 1) = 5 Or _
Mid(IntegerText, x, 1) = 6 Or _
Mid(IntegerText, x, 1) = 7 Or _
Mid(IntegerText, x, 1) = 8 Or _
Mid(IntegerText, x, 1) = 9 Or _
Mid(IntegerText, x, 1) = "," Then
Else
IsValue = False
End If
x = x + 1
Wend
IntegerPart = Left(IntegerText, x - 2)

'throw away the integer part bit
For y = x - 1 To Len(IntegerText)
FractionText = FractionText & Mid(IntegerText, y, 1)
Next y

'find if next character is a "."

If Left(FractionText, 1) = "." Then
If _
Mid(FractionText, 2, 1) = 0 Or _
Mid(FractionText, 2, 1) = 1 Or _
Mid(FractionText, 2, 1) = 2 Or _
Mid(FractionText, 2, 1) = 3 Or _
Mid(FractionText, 2, 1) = 4 Or _
Mid(FractionText, 2, 1) = 5 Or _
Mid(FractionText, 2, 1) = 6 Or _
Mid(FractionText, 2, 1) = 7 Or _
Mid(FractionText, 2, 1) = 8 Or _
Mid(FractionText, 2, 1) = 9 Then

'walk through FractionText starting from
'the second character until the character is no varianter a
number

IsValue = True
x = 2
While IsValue = True
If _
Mid(FractionText, x, 1) = 0 Or _
Mid(FractionText, x, 1) = 1 Or _
Mid(FractionText, x, 1) = 2 Or _
Mid(FractionText, x, 1) = 3 Or _
Mid(FractionText, x, 1) = 4 Or _
Mid(FractionText, x, 1) = 5 Or _
Mid(FractionText, x, 1) = 6 Or _
Mid(FractionText, x, 1) = 7 Or _
Mid(FractionText, x, 1) = 8 Or _
Mid(FractionText, x, 1) = 9 Then
Else
IsValue = False
End If
x = x + 1
Wend
FractionPart = Mid(FractionText, 2, x - 3)
Else
End If
End If

FractionPart = FractionPart / (10 ^ Len(FractionPart))
ExtractedValue = IntegerPart + FractionPart
End Function

wrote:
Hello Gents/Ladies...another question....

I have a cell, C13, that says:

Bonus: $4,000 (DEC06).

My question:
How can I copy just 4,000 from this cell and make K18 say $4,000.

FYI, C13 does not always contain this data, just sometimes. I need
something that would look for the dollar amount and copy only the
dollar amount to K18.

Thanks for all your help, I really appreciate your time.

:o)
Bull


--ron