VBA for count sumif result for range (Macro or UDF)

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,809
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hi Guys.
I want to write UDF or macro to count sumif result if more than one criteria.
I write both But have Problems.
1. User Defined Function:
VBA Code:
Function CountSumResult(InputRange As Range, Criteria As Variant, SumRange As Range, SumCriteria As Long) As Long
    Dim Cell As Range
    Dim SumResult As Long
    Set CountSumResult = 0
    For Each Cell In InputRange
        
          If WorksheetFunction.CountIf(Range(Cells(InputRange.Row, Cell.Column).Address, Cells(Cell.Row, Cell.Column).Address), Cell.Value) = 1 Then
             WorksheetFunction.SumIf(SumRange, Criteria) = SumResult
             WorksheetFunction.CountIf(SumResult, SumCriteria) = CountSum
             CountSumResult = CountSum + CountSumResult
           Else
           CountSumResult = CountSumResult
          End If
     Next Cell
End Function
I Know have problems. but I don't see it when write at Insert function.

2. Macro Shows missmatch for Sumresult
VBA Code:
Sub Countsssss()
    Dim InputRange As Range
    Dim Criteria As Variant
    Dim SumRange As Range
    Dim CountSumResult As Long
    Dim SumCriteria As Variant
    Dim Cell As Range
    Dim SumResult As Long
    Dim CountSum As Long
    
    CountSumResult = 0
    Set InputRange = Range("A2:A22")
    Set SumRange = Range("C2:C22")
    SumCriteria = " >= " & 170
    For Each Cell In InputRange
          If WorksheetFunction.CountIf(Range(Cells(InputRange.Row, Cell.Column).Address, Cells(Cell.Row, Cell.Column).Address), Cell.Value) = 1 Then
          
            SumResult = WorksheetFunction.SumIf(SumRange, Range("$B$2")) + WorksheetFunction.SumIf(SumRange, Range("$B$3"))
            Debug.Print SumResult
            CountSum = WorksheetFunction.CountIf(SumResult, SumCriteria)
            Debug.Print CountSum
            CountSumResult = CountSum + CountSumResult
            Debug.Print CountSumResult
           Else
            CountSumResult = CountSumResult
          End If
    Next Cell
End Sub

Please help
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
The Countif function requires a range, not a single value.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,809
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Thanks Fluff. I understand and after try and try, I find Solution.
1. Macro
VBA Code:
Sub CountSumResults()
    Dim InputRange As Range
    Dim Criteria As Variant
    Dim SumRange As Range
    Dim CountSumResult As Long
    Dim SumCriteria As Variant
    Dim Cell As Range
    Dim SumResult As Variant
    Dim CountSum As Long
    Dim CriteriaRange As Range
    CountSumResult = 0
    'Set InputRange for Employee Names
     Set InputRange = Range("A2:A22")
     'Set CriteriaRange for Criteria Column ("leave" & "RDO")
    Set CriteriaRange = Range("B2:B22")
    'Set SumRange for Total Hour Column
    Set SumRange = Range("C2:C22")
    'Divide your Criteria Hour to 24 Because one day is 24 Hours
    SumCriteria = 100 / 24
    For Each Cell In InputRange
          If WorksheetFunction.CountIf(Range(Cells(InputRange.Row, Cell.Column).Address, _
          Cells(Cell.Row, Cell.Column).Address), Cell.Value) = 1 Then
          SumResult = WorksheetFunction.Sum(WorksheetFunction.SumIfs(SumRange, CriteriaRange, Range("$B$2"), _
            InputRange, Cells(Cell.Row, Cell.Column).Value), WorksheetFunction.SumIfs(SumRange, CriteriaRange, _
            Range("$B$3"), InputRange, Cells(Cell.Row, Cell.Column).Value))
            If SumResult >= SumCriteria Then
               CountSum = 1
            Else
               CountSum = 0
            End If
               CountSumResult = CountSum + CountSumResult
           Else
               CountSumResult = CountSumResult
          End If
     
    Next Cell

    Range("E2").Value = CountSumResult
End Sub

2. UDF

VBA Code:
Function CountSumResult(InputRange As Range, CriteriaRange As Range, Criteria1 As Variant, Criteria2 As Variant, SumRange As Range, SumCriteria As Long) As Long

    Dim Cell As Range
    Dim SumResult As Long
    Dim CountSum As Long
    CountSumResult = 0
    
    For Each Cell In InputRange
        
          If WorksheetFunction.CountIf(Range(Cells(InputRange.Row, Cell.Column).Address, _
          Cells(Cell.Row, Cell.Column).Address), Cell.Value) = 1 Then
          
            SumResult = WorksheetFunction.SumIfs(SumRange, CriteriaRange, Criteria1, InputRange, _
            Cells(Cell.Row, Cell.Column).Value) + WorksheetFunction.SumIfs(SumRange, CriteriaRange, _
            Criteria2, InputRange, Cells(Cell.Row, Cell.Column).Value)
            Debug.Print SumResult
            'CountSum = WorksheetFunction.CountIf(SumResult, SumCriteria)
            If SumResult >= SumCriteria Then
               CountSum = 1
            Else
               CountSum = 0
            End If
            
            Debug.Print CountSum
            CountSumResult = CountSum + CountSumResult
            Debug.Print CountSumResult
           Else
            CountSumResult = CountSumResult
          End If
     
    Next Cell
  
End Function
 
Solution

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,614
Office Version
  1. 365
Platform
  1. Windows
Glad you sorted it & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,674
Messages
5,637,726
Members
416,981
Latest member
PLonchar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top