VBA Pull out Currency from string

anthonyexcel

Active Member
Joined
Jun 10, 2011
Messages
258
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 create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
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)

.
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
JoeMo,
Thank you so much it did exactly what I needed! Amazing! Thank you again much appreciated!
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

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
Back
Top