Extract Part of Sentence for Separate Cell's Value

M

MrsForeman

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.

:eek:)
Bull
 
R

Ron Rosenfeld

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.

:eek:)
Bull

Your specifications are incomplete. In particular, you do not indicate what
you wish to happen should the data you describe not be in the cell.

To copy the value 4000 (not the text string 4,000) to cell K18 and "make K18
say" $4,000:

1. Format K18 as currency with zero decimal places.
2. Put the following formula in K18:

=--MID(C13,FIND("$",C13)+1,FIND(" ",C13,
FIND("$",C13)+1-FIND("$",C13))-1)

This formula will give a VALUE error if C13 does not contain the appropriate
data. But you'll have to tell us what you want to happen in that instance.


--ron
 
M

MrsForeman

Got it Ron..if the data (i.e. Bonus: $4,000 (DEC06)) is not in the cell
then I would like K18 to say nothing or just ignore C13...I only want
K18 to have $4,000 or whatever dollar amount is listed in C13....

Is this what you mean?
 
R

Ron Rosenfeld

Got it Ron..if the data (i.e. Bonus: $4,000 (DEC06)) is not in the cell
then I would like K18 to say nothing or just ignore C13...I only want
K18 to have $4,000 or whatever dollar amount is listed in C13....

Is this what you mean?

Not exactly. However, you've already responded to Tom that C13 might be empty,
or might contain your text string including a dollar amount.

That being the case, he has supplied you with the appropriate modification of
the formula I supplied.


--ron
 
B

Ben

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
 
R

Ron Rosenfeld

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
============================


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

--ron
 
M

MrsForeman

holy cow...Thanks a bunch guys...Take it easy.
Ron said:
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
============================


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

--ron
 
H

Harlan Grove

Ron Rosenfeld said:
Perhaps a bit shorter: ....
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
....

I could quibble about the return value, but I'll concentrate on
inefficiency.

There's no good point to calling .Test and .Execute. Just call
..Execute. That is, replace the If block with

Set colMatches = objRe.Execute(rg.Text)
ParseVal = IIf(colMatches.Count > 0, CDbl(colMatches(0)), "")

but even then this is much, much slower than using built-in worksheet
functions.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top