UDF or similar to extract currency amounts or numbers and symbols from text string

[FreeRangeJ]

i have a description column that contains the financial amounts that should be in other columns. I want to extract these amounts into helper columns, not the intended financial columns for validation purposes.

I've found a udf that almost works to pull all numbers from a text string but puts them in a number string with no grouping or symbols, another issue is that even though there are several decimal amounts in the string it pulls the last through or the only one through and decimals the whole resulting number string from that point

I've also found a udf that extracts the symbols into a symbol string

<tbody>

Order Detail	UDF:Extract Numbers (as Number 0 decimals)	UDF:Extract Numbers (as Number 2 decimals)	UDF: Extract Symbols
Random Product 3 Qty: 4 Monthly: £7.00 Total Monthly: £28.00 Monthly Rollinng Tarrif national- 0.9bst allowance 3- 3.4mms	3470028000933	3470028000933.40	: : £. : £. - . - .
23 johbfcvasebn 45 gtr ty65h mt 657	234565657	234565657.00
23 johbfcvasebn 45 gtr. ty65h mt 657	2346	2345.66	.

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

</tbody>

so if you can almost do numbers and you can do symbols separately is there a way to do numbers fully combined with symbols and moreover is there a udf or similar to extract them (numbers and symbols) in the groups they appear in the string (using spaces as a delimiter?) so as in the first example:

3 : 4 : £7.00 : £28.00 - 0.9 3- 3.4

or in a string:

3:4:£7.00:£28.00-0.93-3.4

I don't fully understand the udfs i found, i can just see that the numbers one is kinda almost there, it reads like this:



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



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

thanks in advance!

 

[FreeRangeJ]

Rick

That's absolutely fantastic, thanks for your help!

 

[FreeRangeJ]

Rick

Thast's fantastic, thanks for your help!

 

[FreeRangeJ]

Hi Rick

The UDF you sent me worked great, thanks again.

I have however (with no VBA) been trying to mongrel it to make another udf to perform another function, in the same way as i needed to extract amounts from a text string I have another dataset with a 4 or 5 digit numerical code within a text string prefixed with sf without a space, so sf**** or sf*****, i could do with something that would extract this, even if it were one for the 4 digit code and another for the 5 maybe?

 

[Rick Rothstein]

I have however (with no VBA) been trying to mongrel it to make another udf to perform another function, in the same way as i needed to extract amounts from a text string I have another dataset with a 4 or 5 digit numerical code within a text string prefixed with sf without a space, so sf**** or sf*****, i could do with something that would extract this, even if it were one for the 4 digit code and another for the 5 maybe?

See if this UDF works for you...

Function SF(S As String, DigitCount) As String
  Dim X As Long, Parts() As String
  Parts = Split(S, "sf", , vbTextCompare)
  For X = 1 To UBound(Parts)
    If Parts(X) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
      SF = "sf" & Left(Parts(X), DigitCount)
      Exit For
    End If
  Next
End Function

The function takes two arguments... the first is the text to be parsed (can be a text string or a cell reference that contain a text string) and the second is how many digits in the code you want to find. So, SF(A1,4) would retrieve a 4-digit code (following the "sf") in cell A1, if any, and SF(A1,5) would retrieve a 5-digit code, if any.

 

[FreeRangeJ]

See if this UDF works for you...

Function SF(S As String, DigitCount) As String
  Dim X As Long, Parts() As String
  Parts = Split(S, "sf", , vbTextCompare)
  For X = 1 To UBound(Parts)
    If Parts(X) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
      SF = "sf" & Left(Parts(X), DigitCount)
      Exit For
    End If
  Next
End Function

The function takes two arguments... the first is the text to be parsed (can be a text string or a cell reference that contain a text string) and the second is how many digits in the code you want to find. So, SF(A1,4) would retrieve a 4-digit code (following the "sf") in cell A1, if any, and SF(A1,5) would retrieve a 5-digit code, if any.

Works a treat, again, many thanks!

 

[FreeRangeJ]

Hi Rick

These UDFs have been invaluable in my project, thanks again.

Is there a way to have a udf to replace the manual version of find, copy and paste, like the previous extraction udfs but where i can tell it the extraction text (alphanumeric) each time i run it?

 

[FreeRangeJ]

Hi Rick

I'm just trying to edit your udf for the same 4/5 digit code out of a free text field bu this time prefixed like the examples below:

STYLE=0,HEIGHT=20,COLOR=0,BACKGROUND=-1,BORDER=0,FONT=Arial,VALUE=Order: 05763

STYLE=0,HEIGHT=16,COLOR=0,BACKGROUND=-1,BORDER=0,FONT=Arial,VALUE=Order: 03211

Order: 10317

So I've adjusted your udf to the following (as a total guess from a novice) to:

Function Order(S As String, DigitCount) As String
Dim X As Long, Parts() As String
Parts = Split(S, "Order: ", , vbTextCompare)
For X = 1 To UBound(Parts)
If Parts(X) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
SF = "Order: " & Left(Parts(X), DigitCount)
Exit For
End If
Next
End Function



It's not running but given I've no clue what I'm doing I'm not that surprised. Given the prefix of Order : is sometimes preceeded by a space ond in other instances not does this make a difference?

 

[Rick Rothstein]

Given the prefix of Order : is sometimes preceeded by a space ond in other instances not does this make a difference?

Do you mean the colon {:} sometimes has a space in front of it? If so, give this a try...

Function Order(S As String, DigitCount) As String
  Dim X As Long, Parts() As String
  Parts = Split(Replace(S, " :", ":"), "Order:", , vbTextCompare)
  For X = 1 To UBound(Parts)
    If Trim(Parts(X)) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
      Order = "Order: " & Left(Trim(Parts(X)), DigitCount)
      Exit For
    End If
  Next
End Function

 

[FreeRangeJ]

Do you mean the colon {:} sometimes has a space in front of it? If so, give this a try...

Function Order(S As String, DigitCount) As String
  Dim X As Long, Parts() As String
  Parts = Split(Replace(S, " :", ":"), "Order:", , vbTextCompare)
  For X = 1 To UBound(Parts)
    If Trim(Parts(X)) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
      Order = "Order: " & Left(Trim(Parts(X)), DigitCount)
      Exit For
    End If
  Next
End Function

No, sometimes the space is in front of Order: and sometimes Order: is unspaced straight from a text string...

 

[Rick Rothstein]

No, sometimes the space is in front of Order: and sometimes Order: is unspaced straight from a text string...

Ah, never mind, I see what the problem is with your originally attempted revision. You posted this...

Function Order(S As String, DigitCount) As String
  Dim X As Long, Parts() As String
  Parts = Split(S, "Order: ", , vbTextCompare)
  For X = 1 To UBound(Parts)
    If Parts(X) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
      [B][COLOR="#FF0000"]SF[/COLOR][/B] = "Order: " & Left(Parts(X), DigitCount)
      Exit For
    End If
  Next
End Function

The red highlighted text above should be the same as the function name (that is how the calculated value is returned from the function... you assign the value directly to the function name)...

Function Order(S As String, DigitCount) As String
  Dim X As Long, Parts() As String
  Parts = Split(S, "Order: ", , vbTextCompare)
  For X = 1 To UBound(Parts)
    If Parts(X) & " " Like String(DigitCount, "#") & "[!0-9]*" Then
      [B][COLOR="#FF0000"]Order[/COLOR][/B] = "Order: " & Left(Parts(X), DigitCount)
      Exit For
    End If
  Next
End Function