User Tools

Site Tools


microsoft_excel:macros:sum:sum_sequentially

Microsoft Excel - Macros - Sum - Sum Sequentially

' Returns the sum of all oArrWithValues for all vCrit found within the array oArrWithCrit.
Function ArraySumIfSequential(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant)
    Dim vArr1 As Variant
    Dim vArr2 As Variant
    Dim lRow As Long
    If (UBound(oArrWithCrit) - LBound(oArrWithCrit)) = (UBound(oArrWithValues) - LBound(oArrWithValues)) Then
        For lRow = LBound(oArrWithCrit, 1) To UBound(oArrWithCrit, 1)
            If oArrWithCrit(lRow, 1) = vCrit Then
                ArraySumIfSequential = ArraySumIfSequential + oArrWithValues(lRow, 1)
            End If
        Next
    Else
        ArraySumIfSequential = "Criteriarange and sum range must be of same length"
    End If
 
 
    ' Clear all objects.
    Set vArr1 = Nothing
    Set vArr2 = Nothing
 
End Function

or

'=ArraySumIf(A1:A1000,"Foo",B1:B1000)
Function RangeSumIf(oRngWithCrit As Range, vCrit As Variant, oRngWithValues As Range)
    Dim vArr1 As Variant
    Dim vArr2 As Variant
    Dim lRow As Long
    If oRngWithCrit.Rows.Count = oRngWithValues.Rows.Count Then
        vArr1 = oRngWithCrit.Value
        vArr2 = oRngWithValues.Value
        For lRow = LBound(vArr1, 1) To UBound(vArr1, 1)
            If vArr1(lRow, 1) = vCrit Then
                RangeSumIf = ArraySumIf + vArr2(lRow, 1)
            End If
        Next
    Else
        RangeSumIf = "Criteriarange and sum range must be of same length"
    End If
 
 
    ' Clear all objects.
    Set vArr1 = Nothing
    Set vArr2 = Nothing
 
End Function
microsoft_excel/macros/sum/sum_sequentially.txt · Last modified: 2021/08/04 15:45 by peter

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki