CODEWITHSUNDEEP
excelvba
Valdet Osmani
Valdet Osmani

Reputation: 23

Sum a Range of Values conditionally

I want to sum a range of values, excluding the cells where another cell in the same row contains a specified value.

I need to do the following implementation in Excel using VBA.

I have the following data as reported in the example below:

Initial Result

I need the SUM of days excluding the days required for "Test".

I know offSet does something similar, however, the "Test" can be randomly inserted on any field, therefore, I need a dynamic calculation.

The desired output is 16.

Upvotes: 1

Views: 540

Answers (3)

Ferdinando
Ferdinando

Reputation: 964

An alternative code where you can choose the item that doesn't sum:

Example: before you execute the macro:

enter image description here

You choose the item(active Cell) in this example I chose B (Total is 20 - B value(3) = 17) execute the macro you get:

enter image description here

The code snippet is:

Sub test()
'i suppose the name are on the A column and the value are in b column
Dim rows As Integer
Dim sum As Double

sum = 0

'count how many rows
rows = ActiveSheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).count

For i = 2 To rows

    'sum the value
    sum = sum + Cells(i, 2) 'column B value

Next i

'subtract the item focused
sum = sum - Cells(ActiveCell.Row, 2)

'write sum in the last row (column B)
Cells(rows + 1, 2) = sum

End Sub

Upvotes: 0

VBasic2008
VBasic2008

Reputation: 54948

The Array loses to SumIf

The funniest thing is that it takes longer for the line

vntArr = objRng

(i.e. paste the range into an array) than for the whole SumIf Code to finish.

At one million rows it would take the 'Array' version less than 4 seconds while the 'SumIf' version would take less than 1.5 seconds.

'*******************************************************************************
'Purpose:   Sums up a range of values excluding the values of cells where
'           another cell in the same row contains a specified value.
'*******************************************************************************
Sub SumifArray()

  Const cstrName As String = "Sheet1" 'Name of the worksheet to be processed
  Const cLngFirstRow As Long = 2 'First row of data (excluding headers)
  Const cStrSumColumn As String = "B" 'The column to sum up
  Const cStrCheckColumn As String = "A" 'The column where to check against
  Const cStrCheckString As String = "Test" 'The value to be checked against

  Dim objRng As Range 'The range of data (both columns)
  Dim vntArr As Variant 'The array where the range is to be pasted into
  Dim lngLastRowCheck As Long 'Calculated last row of data in the "check" column
  Dim lngLastRowSum As Long 'Calculated last row of data in the "sum" column
  Dim lngArrCounter As Long 'Array row counter
  Dim lngSum As Long 'Value accumulator

  With Worksheets(cstrName)
    ' Last used row in column cStrCheckColumn
    lngLastRowCheck = .Columns(cStrCheckColumn).Find(What:="*", _
        After:=.Cells(1, cStrCheckColumn), LookIn:=xlFormulas, _
        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ' Last used row in column cStrSumColumn
    lngLastRowSum = .Columns(cStrSumColumn).Find(What:="*", _
        After:=.Cells(1, cStrSumColumn), LookIn:=xlFormulas, _
        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  End With

  ' Calculate the range of data
  Set objRng = Range(Cells(2, cStrCheckColumn), _
      Cells(lngLastRowCheck, cStrSumColumn))
  ' Paste the range of data into an array (One-based, two-dimensional)
  vntArr = objRng
  ' Release object variable: the data is in the array
  Set objRng = Nothing

  ' Loop through the array
  For lngArrCounter = LBound(vntArr) To UBound(vntArr)
    ' Check if the value in the "check" column isn't equal to cStrCheckString
    If vntArr(lngArrCounter, 1) <> cStrCheckString Then _
        lngSum = lngSum + vntArr(lngArrCounter, 2)
  Next

  ' Write the result into the first empty row after the last row of data in
  ' the "sum" column
  Worksheets(cstrName).Cells(lngLastRowSum + 1, cStrSumColumn) = lngSum

End Sub

Upvotes: 0

Error 1004
Error 1004

Reputation: 8230

For this example i use Sheet1 with a dynamic range starting from A2 to LastRow.

Try:

Sub Test()
    Dim LR As Long
    Dim Total As Variant

    With Worksheets("Sheet1")
         LR = .Cells(.Rows.Count, "A").End(xlUp).Row
         Total = Application.WorksheetFunction.SumIf(.Range("A2:A" & LR), "<>Test", .Range("B2:B" & LR))
    End With
End Sub

Upvotes: 1

Related Questions