CODEWITHSUNDEEP
excelvba
Gonçalo Geraldes
Gonçalo Geraldes

Reputation: 15

Create a custom SUM function with VBA

I have a table called ("Vendas2020") that has the daily sales and each row has either "C" or "V" if they're either a purchase or a sale (C/V column is the fifth one and is called "Compra / Venda"). I have inserted a function to only calculate the visible values in the table since the destination worksheet (which is a report called "Relatório") has slicers for the products, salesperson and year. The code for the sumfunction is as follows:

Function SUMVisible(Rg As Range)
  Dim xCell As Range
  Dim xCount As Integer
  Dim xTtl As Double

  Application.Volatile
  Set Rg = Intersect(Rg.Parent.UsedRange, Rg)

  For Each xCell In Rg
    If xCell.ColumnWidth > 0 _
       And xCell.RowHeight > 0 _
       And Not IsEmpty(xCell) _
       And IsNumeric(xCell.Value) _
    Then
      xTtl = xTtl + xCell.Value
      xCount = xCount + 1
    End If
  Next
  If xCount > 0 Then
    SUMVisible = xTtl
  Else
    SUMVisible = 0
  End If
End Function

I'd like to add an if statement (or something like it) that only sums the values if they're purchases ("V") but I can't seem to make it work. It either throws a value error or a spill error. I can't seem to find a thread that has a solution that might apply in this case. I know it's something simple but I'm somewhat new to VBA. Thanks in advance!

Upvotes: 1

Views: 843

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Sub Total with Criteria (UDF)

  • If you have the values in A1:A10 and the criteria in the B column, then in Excel for the criteria "V" you would use:

     =SumVisible(A1:A10,1,"V")

The Code

Option Explicit

Function SUMVisible(SumRange As Range, _
                    Optional ColumnOffset As Long, _
                    Optional Criteria As Variant) _
         As Double
    
    Dim xCell As Range
    Dim xTtl As Double
    
    Application.Volatile
    
    If ColumnOffset = 0 Or IsMissing(Criteria) Then
        For Each xCell In SumRange
            If xCell.ColumnWidth > 0 And _
              xCell.RowHeight > 0 And _
              Not IsEmpty(xCell) And _
              IsNumeric(xCell.Value) Then
                xTtl = xTtl + xCell.Value
            End If
        Next
    Else
        For Each xCell In SumRange
            If xCell.ColumnWidth > 0 And _
              xCell.RowHeight > 0 And _
              Not IsEmpty(xCell) And _
              IsNumeric(xCell.Value) And _
              xCell.Offset(, ColumnOffset).Value = Criteria Then
                xTtl = xTtl + xCell.Value
            End If
        Next
    End If
    
    SUMVisible = xTtl

End Function

Upvotes: 1

Related Questions