Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.
Public Function SumVlookups(ByVal Lookupvalue As Double, ByVal RangeToSum As Range) As Double
Dim Found As Variant
Dim varData
Dim varVal
Dim varValue
Dim n As Long
varData = RangeToSum.Value
For n = LBound(varData, 1) To UBound(varData, 1)
' load array data
If InStr(varData(n, 1), Lookupvalue & ",") > 0 Then
Found = Evaluate(varData(n, 1))
If Not IsError(Found) Then
' check for match on lookup value
varVal = Application.VLookup(Lookupvalue, Found, 1, False)
If Not IsError(varVal) Then
' return relvant value from second column
varValue = Application.VLookup(Lookupvalue, Found, 2, False)
' make sure it's a number
If IsNumeric(varValue) Then
SumVlookups = SumVlookups + varValue
Else
SumVlookups = CVErr(xlErrValue)
Exit For
End If
End If
End If
End If
Next n
End Function
Public Function SumVlookups(ByVal Lookupvalue As Single, ByVal RangeToSum As Range) As Single
Dim ArrayStr As Range
Dim Found As Variant
For Each ArrayStr In RangeToSum
Found = Evaluate(ArrayStr.Value)
If Not IsError(Application.VLookup(Lookupvalue, Found, 1, False)) Then SumVlookups = SumVlookups + Application.VLookup(Lookupvalue, Found, 2, False)
Next ArrayStr
End Function
Public Function SumVlookups(ByVal Lookupvalue As Double, ByVal RangeToSum As Range) As Double
Dim varRowData
Dim varItemData
Dim varData
Dim n As Long
Dim x As Long
Dim y As Long
Dim lngStart As Long
Dim lngStop As Long
varData = RangeToSum.Value
For n = LBound(varData, 1) To UBound(varData, 1)
' load array data
If InStr(varData(n, 1), Lookupvalue & ",") > 0 Then
varRowData = Split(Mid(varData(n, 1), 2, Len(varData(n, 1)) - 2), ";")
For x = LBound(varRowData) To UBound(varRowData)
varItemData = Split(varRowData(x), ",")
For y = LBound(varItemData) To UBound(varItemData) Step 2
If varItemData(y) = Lookupvalue Then
SumVlookups = SumVlookups + varItemData(y + 1)
Exit For
End If
Next y
Next x
End If
Next n
End Function
Function SumByCriteria(varCriterion, rngData As Range) As Double
Dim varData
Dim varSubData
Dim n As Long
With rngData
varData = Filter(.Worksheet.Evaluate("transpose(if(" & .Address & "="""","""",MID(" & .Address & ",2,len(" & .Address & ")-2)))"), varCriterion & ",")
End With
varSubData = Filter(Split(Join(varData, ";"), ";"), varCriterion & ",")
For n = LBound(varSubData) To UBound(varSubData)
SumByCriteria = SumByCriteria + CDbl(Split(varSubData(n), ",")(1))
Next n
End Function
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
12 Experts available now in Live!