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.
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
A regex based UDF. This is based on the currency being present as text ie 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 .
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.