VBA Pull out Currency from string

anthonyexcel

Board Regular
Joined
Jun 10, 2011
Messages
239
Office Version
  1. 365
Platform
  1. Windows
I have about 150,000 rows of data. What I am looking to do is to pull out the currency to the cell next to it.
The data is formatted like below: Please help. Thanks again!

<style type="text/css">
table.tableizer-table {
font-size: 12px;
border: 1px solid #CCC ;
font-family: Arial, Helvetica, sans-serif;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #CCC ;
}
.tableizer-table th {
background-color: #104E8B ;
color: #FFF ;
font-weight: bold;
}
</style>
Data
$70,645.00
$144,840.00
$205,000.00
Different funded ($43,685); previously funded by x in y
$60,000.00
Paid till 4/17/19 [$172,800, 3 years]
$40,194 [Paid to 9/30/19]

<tbody>
</tbody>
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

Haluk_

Rules violation
Joined
Apr 25, 2018
Messages
13
This UDF may help you;

Code:
Function getAmount(str As String)
    With CreateObject("VBscript.RegExp")
        .Global = True
        .Pattern = "\$\d+(\,\d+)?"
        On Error Resume Next
        If .test(str) Then Set getAmount = .Execute(str)(0)
        If Err <> 0 Then getAmount = vbNullString
    End With
End Function

You can use the UDF for the string in cell A1 as;

Code:
=getAmount(A1)

.
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,705
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Here's a subroutine you can use if your sample data display the full range of data types you will encounter, there is only one currency value per cell, and ($43,685) does not represent a negative amount. First select all the cells you want to extract from, then run the macro below.
Code:
Sub ExtractCurrency()
'select the cells you want to extract from, then run this macro
Dim R As Range, c As Range, X, i As Long
Set R = Selection
Application.ScreenUpdating = False
For Each c In R
    If Val(c.Value) = c.Value Then
        c.Offset(0, 1).Value = c.Value
    ElseIf InStr(c.Value, "$") > 0 Then
        c.Value = Replace(Replace(Replace(Replace(Replace(c.Value, ", ", " "), "(", " "), ")", " "), "[", " "), "]", " ")
        X = Split(c.Value, " ")
        For i = LBound(X) To UBound(X)
            If X(i) Like "$*" Then
               c.Offset(0, 1).Value = X(i)
                Exit For
            End If
        Next i
    Else
        c.Offset(0, 1).Value = "#N/A"
    End If
Next c
Application.ScreenUpdating = True
End Sub
 

anthonyexcel

Board Regular
Joined
Jun 10, 2011
Messages
239
Office Version
  1. 365
Platform
  1. Windows
Thank you both! I appreciate the help and guidance! JoeMo Is there a way to amend your code to give me the sum of the selection of values in a cell lets say K1?
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,705
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

Thank you both! I appreciate the help and guidance! JoeMo Is there a way to amend your code to give me the sum of the selection of values in a cell lets say K1?
You are welcome.

This modified version will place the sum of the extracted values in cell K1.
Code:
Sub ExtractCurrency()
'select the cells you want to extract from, then run this macro
Dim R As Range, c As Range, X, i As Long, S As Double
Set R = Selection
Application.ScreenUpdating = False
For Each c In R
    If Val(c.Value) = c.Value Then
        c.Offset(0, 1).Value = c.Value
        S = S + c.Offset(0, 1).Value
    ElseIf InStr(c.Value, "$") > 0 Then
        c.Value = Replace(Replace(Replace(Replace(Replace(c.Value, ", ", " "), "(", " "), ")", " "), "[", " "), "]", " ")
        X = Split(c.Value, " ")
        For i = LBound(X) To UBound(X)
            If X(i) Like "$*" Then
                c.Offset(0, 1).Value = X(i)
                S = S + c.Offset(0, 1).Value
                Exit For
            End If
        Next i
    Else
        c.Offset(0, 1).Value = "#N/A"
    End If
Next c
[K1] = Format(S, "Currency")
Application.ScreenUpdating = True
End Sub
 

anthonyexcel

Board Regular
Joined
Jun 10, 2011
Messages
239
Office Version
  1. 365
Platform
  1. Windows
JoeMo,
Thank you so much it did exactly what I needed! Amazing! Thank you again much appreciated!
 

Forum statistics

Threads
1,148,294
Messages
5,745,942
Members
423,985
Latest member
sayed manzar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top