Excel formula to sum up column of specific currencies

Question

I have the following column in Excel.

I would like to have an Excel formula that can sum up cells of specific currencies. The cells are in currencies format. VBA user-defined function is fine too but the preference is an Excel formula.

I am using Excel 2016.

EDIT: The cells are in currency format. The currency symbol prefix in front is not string in the cell.

Answer 1

So I went the UDF route -- let me know if this works for you. If you need assistance on how to get this up and running feel free to let me know.

The syntax for the UDF is CurrencyVal(Range you're using as a "sumif", a cell with the formatting you're looking to sum)

So for example:

If I have range(A2:A5) where A2 = Euros, and all else is USD then to get the sum of USD you would enter the following into any cell =CurrencyVal (A2:A5, A3).

Option Explicit
Function CurrencyVal(SumCellRange As Range, CurrencySumCell As Range) As Integer

Dim Cell As Variant
Dim SumRange As Integer

For Each Cell In SumCellRange
    If Cell.NumberFormat = CurrencySumCell.NumberFormat Then
        SumRange = SumRange + Cell
    End If
Next Cell


CurrencyVal = SumRange


End Function

Answer 2

A regex based UDF. This is based on the currency being present as text i.e. has USD/EUR etc in the cell.

Option Explicit

Public Function GetCurrencySum(ByVal rng As Range, ByVal aCurrency As String) As Variant
    Dim inputString As String, arr()
    If rng.Columns.Count > 1 Then
        GetCurrencySum = CVErr(xlErrNA)
        Exit Function
    End If

    Select Case rng.Count
    Case 1
        ReDim arr(0): arr(0) = rng.Value
    Case Else
        arr = rng.Value
    End Select

    inputString = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1)), "~") & "~"

    Dim matches As Object, match As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "[+-]?" & aCurrency & ".*?(?=~)"
        On Error GoTo errhand:
        If .TEST(inputString) Then
            Set matches = .Execute(inputString)
            For Each match In matches
                 GetCurrencySum = GetCurrencySum + CDbl(Replace$(match, aCurrency, vbNullString))
            Next
            Exit Function
        End If
        GetCurrencySum = 0
        Exit Function
    End With
errhand:
    GetCurrencySum = CVErr(xlErrNA)
End Function

---

In sheet:

---

Regex:

Try it here.

[+-]?JPY.*?(?=~)
/
gm

Match a single character present in the list below [+-]?

? Quantifier — Matches between zero and one times, as many times as possible, giving back as needed (greedy) +- matches a single character in the list +- (case sensitive)

JPY matches the characters JPY literally (case sensitive) '

.*? matches any character (except for line terminators) *? Quantifier — Matches between zero and unlimited times, as few times as possible, expanding as needed (lazy)

Positive Lookahead (?=~)

Assert that the Regex below matches ~ matches the character ~ literally (case sensitive)

---

If there is other text in the cell then you could try:

Public Function GetCurrencySum(ByVal rng As Range, ByVal aCurrency As String) As Variant
    Dim inputString As String, arr()
    If rng.Columns.Count > 1 Then
        GetCurrencySum = CVErr(xlErrNA)
        Exit Function
    End If

    Select Case rng.Count
    Case 1
        ReDim arr(0): arr(0) = rng.Value
    Case Else
        arr = rng.Value
    End Select

    inputString = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1)), "~") & "~"

    Dim matches As Object, match As Object
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "[\-\+]?" & aCurrency & "\s[\d,.]+"
        On Error GoTo errhand:
        If .test(inputString) Then
            Set matches = .Execute(inputString)
            For Each match In matches
                  GetCurrencySum = GetCurrencySum + CDbl(Replace$(Replace$(match, aCurrency, vbNullString), "~", vbNullString))
            Next
            Exit Function
        End If
        GetCurrencySum = 0
        Exit Function
    End With
errhand:
    GetCurrencySum = CVErr(xlErrNA)
End Function

Try it here.

Answer 3

I made some modifications to Dylan's answer to make some customizations to suit my own preferences. I post this answer to my own question for future reference.

Suppose there is a range(A2:A5) where A2 = Euros, and all else is USD then to get the sum of USD, you would enter the following into any cell =GetCurrencySum(A2:A5, "[$USD] #,##0.00").

Function GetCurrencySum(SumCellRange As Range, CurrencyFormat As String) As Single
    On Error GoTo errorhd
    Dim Cell As Variant
    Dim SumRange As Single

    SumRange = 0
    For Each Cell In SumCellRange
        If Cell.NumberFormat = CurrencyFormat Then
            SumRange = SumRange + Cell
        End If
    Next Cell    

    GetCurrencySum = SumRange
    Exit Function
errorhd:
    MsgBox Err.Source & "-->" & Err.Description, , "CurrencyVal"
End Function