Member Avatar for rahul.katiyar.7731

I want the vba coding of the formula SUMIFS in MS-Excel 2007, so I can copy the code and paste it in the Module of MS-Excel 2003 to use the formula in this version.

[url= Lake[/url]

  • 2 Contributors
  • 2 Replies
  • 276 Views
  • 21 Hours Discussion Span
  • Latest Post Latest Post by rahul.katiyar.7731

Dani AI

Generated

was right that SUMIFS is a built-in worksheet function starting with Excel 2007. For Excel 2003 the following user-defined function (UDF) reproduces SUMIFS behavior: it accepts the same argument pattern (SumRange, CriteriaRange1, Criterion1, ...) and supports comparison operators (>, <, >=, <=, <>) and wildcards (* and ?). This addresses 's request to paste VBA into a module for use on older Excel.

Option Explicit

' SUMIFS_2003: drop into a standard module in Excel 2003
' Usage: =SUMIFS_2003(SumRange, CritRange1, Crit1, CritRange2, Crit2, ...)
Public Function SUMIFS_2003(SumRng As Range, ParamArray args() As Variant) As Variant
    Dim argCount As Long, nArgs As Long
    Dim rCount As Long, cCount As Long
    Dim r As Long, c As Long, j As Long
    Dim rng As Range, crit As Variant
    Dim total As Double, sumVal As Variant
    Dim matchAll As Boolean

    On Error GoTo ErrHandler
    If SumRng Is Nothing Or SumRng.Areas.Count <> 1 Then
        SUMIFS_2003 = CVErr(xlErrRef): Exit Function
    End If

    On Error Resume Next
    argCount = UBound(args) + 1
    On Error GoTo ErrHandler
    If argCount <= 0 Or (argCount Mod 2) <> 0 Then
        SUMIFS_2003 = CVErr(xlErrValue): Exit Function
    End If

    nArgs = argCount
    rCount = SumRng.Rows.Count: cCount = SumRng.Columns.Count

    For j = 0 To nArgs - 1 Step 2
        If Not TypeOf args(j) Is Range Then
            SUMIFS_2003 = CVErr(xlErrValue): Exit Function
        End If
        Set rng = args(j)
        If rng.Areas.Count <> 1 Or rng.Rows.Count <> rCount Or rng.Columns.Count <> cCount Then
            SUMIFS_2003 = CVErr(xlErrRef): Exit Function
        End If
    Next j

    total = 0
    For r = 1 To rCount
        For c = 1 To cCount
            matchAll = True
            For j = 0 To nArgs - 1 Step 2
                Set rng = args(j)
                crit = args(j + 1)
                If Not CriteriaMatch(rng.Cells(r, c).Value, crit) Then
                    matchAll = False: Exit For
                End If
            Next j
            If matchAll Then
                sumVal = SumRng.Cells(r, c).Value
                If IsNumeric(sumVal) Then total = total + CDbl(sumVal)
            End If
        Next c
    Next r

    SUMIFS_2003 = total
    Exit Function

ErrHandler:
    SUMIFS_2003 = CVErr(xlErrValue)
End Function

Private Function CriteriaMatch(cellVal As Variant, crit As Variant) As Boolean
    Dim sCrit As String, op As String
    Dim numCrit As Double, ops As Variant, k As Long

    ops = Array(">=", "<=", "<>", ">", "<", "=")
    If IsError(cellVal) Then Exit Function
    If IsObject(crit) Then crit = crit.Value
    If IsError(crit) Then Exit Function

    If VarType(crit) = vbString Then
        sCrit = Trim(crit): op = ""
        For k = LBound(ops) To UBound(ops)
            If Len(sCrit) >= Len(ops(k)) Then
                If Left(sCrit, Len(ops(k))) = ops(k) Then
                    op = ops(k)
                    sCrit = Mid(sCrit, Len(op) + 1)
                    Exit For
                End If
            End If
        Next k

        If Len(sCrit) > 0 And IsNumeric(sCrit) Then
            If Not IsNumeric(cellVal) Then
                If IsNumeric(CStr(cellVal)) Then cellVal = CDbl(cellVal) Else CriteriaMatch = False: Exit Function
            End If
            numCrit = CDbl(sCrit)
            Select Case op
                Case ">=": CriteriaMatch = (CDbl(cellVal) >= numCrit)
                Case "<=": CriteriaMatch = (CDbl(cellVal) <= numCrit)
                Case "<>": CriteriaMatch = (CDbl(cellVal) <> numCrit)
                Case ">": CriteriaMatch = (CDbl(cellVal) > numCrit)
                Case "<": CriteriaMatch = (CDbl(cellVal) < numCrit)
                Case Else: CriteriaMatch = (CDbl(cellVal) = numCrit)
            End Select
            Exit Function
        End If

        If op = "<>" Then
            If sCrit = "" Then
                CriteriaMatch = (Trim(CStr(cellVal)) <> "")
            ElseIf InStr(sCrit, "*") > 0 Or InStr(sCrit, "?") > 0 Then
                CriteriaMatch = Not (LCase(CStr(cellVal)) Like LCase(sCrit))
            Else
                CriteriaMatch = (StrComp(CStr(cellVal), sCrit, vbTextCompare) <> 0)
            End If
            Exit Function
        End If

        If InStr(sCrit, "*") > 0 Or InStr(sCrit, "?") > 0 Then
            CriteriaMatch = (LCase(CStr(cellVal)) Like LCase(sCrit))
        Else
            CriteriaMatch = (StrComp(CStr(cellVal), sCrit, vbTextCompare) = 0)
        End If
    Else
        If IsNumeric(crit) Then
            If IsNumeric(cellVal) Then CriteriaMatch = (CDbl(cellVal) = CDbl(crit)) Else CriteriaMatch = False
        Else
            CriteriaMatch = (CStr(cellVal) = CStr(crit))
        End If
    End If
End Function

Notes and troubleshooting: ranges must be single-area and identical in rows and columns; the function sums numeric cells only; wildcards are matched case-insensitively using VBA Like; if the workbook is opened in Excel 2007+ avoid naming conflicts by keeping the UDF name (SUMIFS_2003) or rename it. If the function returns #VALUE or #REF, check that argument pairs are complete and that each odd argument is a Range with the same shape as SumRange. Performance is slower than the native SUMIFS on large tables; for very large datasets consider helper columns, pivot tables, or upgrading to a native SUMIFS implementation.

Recommended Answers

All 2 Replies

Member Avatar for imBaCodes

What kind of Formula?
A macro? or Like This.

=SUMIFS(A1:A20, B1:B20, ">0", C1:C20, "<10")
Member Avatar for rahul.katiyar.7731

theres no formula that can tell the difference between a formula and a harcoded cell.
so i recorded a quick macro for column B

Sub formulaB()
'
' formulaB Macro
'

'
Range("B1:B1000").Select
Selection.SpecialCells( xlCellTypeFormulas, 23).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

<a href="">damdama lake</a>

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.