VBA Pull out Currency from string

[anthonyexcel]

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>
[TABLE="class: tableizer-table"]
<tbody>[TR="class: tableizer-firstrow"]
[TH]Data[/TH]
[/TR]
[TR]
[TD]$70,645.00[/TD]
[/TR]
[TR]
[TD]$144,840.00[/TD]
[/TR]
[TR]
[TD]$205,000.00[/TD]
[/TR]
[TR]
[TD]Different funded ($43,685); previously funded by x in y[/TD]
[/TR]
[TR]
[TD]$60,000.00[/TD]
[/TR]
[TR]
[TD]Paid till 4/17/19 [$172,800, 3 years][/TD]
[/TR]
[TR]
[TD]$40,194 [Paid to 9/30/19][/TD]
[/TR]
</tbody>[/TABLE]

 

[Haluk_]

This UDF may help you;

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;

=getAmount(A1)

.

 

[JoeMo]

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.

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]

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]

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.

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]

JoeMo,
Thank you so much it did exactly what I needed! Amazing! Thank you again much appreciated!

 

[JoeMo]

JoeMo,
Thank you so much it did exactly what I needed! Amazing! Thank you again much appreciated!

You are welcome - thanks for the reply.