Countifs Function VBA - Multiple selections

A

anshikam

Board Regular
Joined
Aug 20, 2016
Messages
87
Hello,

In one of my scripts the multiple Countif conditions don't seem to work.
However using the Countifs function with 1 condition works.
I don't see anything wrong with the code...not sure where the problem is.



Dim Total As Integer
Total = WorksheetFunction.CountIfs(Range("c:c"), "BIRTHDAY", Range("c:c"), "CELEBRATIONS", Range("C:C"), "ANNIVARSARY")
MsgBox "Total : " & Total
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Sort by date Sort by votes
Try this:

VBA Code: 
Sub Count_If()
'Modified  11/27/2020  4:31:02 AM  EST
Application.ScreenUpdating = True
Dim Total As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
Total = 0
    For i = 1 To Lastrow
        Select Case Cells(i, 3).Value
            Case "BIRTHDAY", "CELEBRATIONS", "ANNIVARSARY"
                Total = Total + 1
        End Select
    Next

MsgBox "Total : " & Total
Application.ScreenUpdating = True
End Sub
 
Upvote 0
My Aswer Is This said:
Try this:

VBA Code: 
Sub Count_If()
'Modified  11/27/2020  4:31:02 AM  EST
Application.ScreenUpdating = True
Dim Total As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
Total = 0
    For i = 1 To Lastrow
        Select Case Cells(i, 3).Value
            Case "BIRTHDAY", "CELEBRATIONS", "ANNIVARSARY"
                Total = Total + 1
        End Select
    Next

MsgBox "Total : " & Total
Application.ScreenUpdating = True
End Sub
Click to expand...
hello the code i mentioned is a part of a larger script which has arrays
Not sure how I can fit this.
Any idea on why the countifs function would not work?
 
Upvote 0
anshikam said:
hello the code i mentioned is a part of a larger script. Not sure how I can fit this.
Any idea on why the countifs function would not work?
Click to expand...
I do not believe your ideal works but someone else may know.
Show me all of your script and i may be able to help more
 
Upvote 0
anshikam said:
Any idea on why the countifs function would not work?
Click to expand...

The criteria in COUNTIFS() are AND's - a cell can't contain all three of the criteria.

You could try:

total = Application.Sum(Application.CountIfs(Range("C:C"), Array("ANNIVARSARY", "CELEBRATIONS", "BIRTHDAY")))

Or in a slightly shorter form.

total = [SUM(COUNTIFS(C:C,{"ANNIVARSARY","CELEBRATIONS","BIRTHDAY"}))]
 
Upvote 0
My Aswer Is This said:
I do not believe your ideal works but someone else may know.
Show me all of your script and i may be able to help more
Click to expand...
Please find below the code. Th code also sends out an email with teh excel file attachment however have not added that on here.
Code works fine with just "BIRTHDAYS" however not with multiple conditions.


Sub BIRTHDAYS()

Workbooks("DD DATABASE.xlsm").Activate
Worksheets("DATABASE").Activate

Call UPDATE_BIRTHDAYS

Dim record_count As Integer
record_count = WorksheetFunction.CountA(Range("b:b"))
record_count = record_count + 1

'MsgBox record_count

Dim ColCat3 As Integer
Dim ColCat1 As Integer
Dim ColDueDate As Integer
Dim CDueDays As Long
Dim ColCatStatus As Integer
Dim ColName As Integer
Dim ColDesignation As Integer
Dim ColBDR As Integer

ColCat3 = WorksheetFunction.Match("CATEGORY3", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColCat1 = WorksheetFunction.Match("CATEGORY1", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColDueDate = WorksheetFunction.Match("DUE*DATE", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
CDueDays = WorksheetFunction.Match("DUE*DAY*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColCatStatus = WorksheetFunction.Match("STATUS", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColName = WorksheetFunction.Match("*E*C*NAME*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColDesignation = WorksheetFunction.Match("*DESIGNATION*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColBDR = WorksheetFunction.Match("*Birthday*Reminder*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)

Dim Cat3 As String
Dim Cat1 As String
Dim Duedate As Date
Dim DueDays As Long
Dim Status As String
Dim Name As String
Dim Designation As String

Dim Total As Integer
Total = WorksheetFunction.CountIfs(Range("c:c"), "BIRTHDAY", Range("c:c"), "CELEBRATIONS", Range("C:C"), "ANNIVARSARY")
MsgBox "Total : " & Total

'WorksheetFunction.Countifs(Worksheets("C&P Output").Range("Ayg3:Ayg10000"), "<" & A100, Worksheets("C&P Output").Range("Ayg3:Ayg10000"), ">" & B100)

Dim J As Integer
J = 2
Dim Z As Integer
Z = 1
'MsgBox j & " " & ColCatStatus
Do While J <= record_count
'Dim Value As String
'Value = Cells(j, ColCat2).Value
'MsgBox Value

If Cells(J, ColCat3).Value = "BIRTHDAY" Or Cells(J, ColCat3).Value = "ANNIVARSARY" Or Cells(J, ColCat3).Value = "CELEBRATIONS" And Cells(J, ColBDR).Value = "Y" Then
'MsgBox "value found"
Dim cell As String
cell = Cells(J, ColCatStatus).Value
'MsgBox j & " " & ColCatStatus & " " & cell
If Cells(J, ColCatStatus).Value = "DUE" Or Cells(J, ColCatStatus).Value = "OVERDUE" Or Cells(J, ColCatStatus).Value = "DUE DATE PENDING" Or Cells(J, ColCatStatus).Value = "DUE TODAY" Then

Cat3 = Cells(J, ColCat3).Value
Cat1 = Cells(J, ColCat1).Value
Duedate = Cells(J, ColDueDate).Value
DueDays = Cells(J, CDueDays).Value
Status = Cells(J, ColCatStatus).Value
Name = Cells(J, ColName).Value
Designation = Cells(J, ColDesignation).Value

'MsgBox Cat2 & vbCrLf & Cat3 & vbCrLf & Duedate & vbCrLf & vbCrLf & Status & vbCrLf & Courtcase
Dim myArray(500, 6) As Variant
myArray(0, 0) = "CATEGORY3"
myArray(0, 1) = "CATEGORY1"
myArray(0, 2) = "DUE DATE"
myArray(0, 3) = "DUE DAYS"
myArray(0, 4) = "STATUS"
myArray(0, 5) = "NAME"
myArray(0, 6) = "DESIGNATION"

myArray(Z, 0) = Cat3
myArray(Z, 1) = Cat1
myArray(Z, 2) = Duedate
myArray(Z, 3) = DueDays
myArray(Z, 4) = Status
myArray(Z, 5) = Name
myArray(Z, 6) = Designation

'MsgBox "Value stored in MyArray record " & vbCrLf & MyArray(0, 0) & " " & MyArray(z, 0) & vbCrLf & MyArray(0, 1) & " " & MyArray(z, 1) & vbCrLf & MyArray(0, 2) & " " & MyArray(z, 2) & vbCrLf & MyArray(0, 3) & " " & MyArray(z, 3) & vbCrLf & MyArray(0, 4) & " " & MyArray(z, 4) & vbCrLf & MyArray(0, 5) & " " & MyArray(z, 5)
Z = Z + 1
End If
End If
J = J + 1
'MsgBox j & " " & ColCatStatus
Loop
Dim Report As String
Dim CDateTime As String
CDateTime = Day(Now()) & Month(Now()) & Year(Now()) & "_" & Hour(Now()) & Minute(Now()) & Second(Now())
Report = "Birthdays_Events_Due" & CDateTime & ".xls"
Dim Path As String
Path = "F:\Corporate\Anshika\Due Dates\sent\"
Workbooks.Add.SaveAs Filename:=Path & Report


Workbooks(Report).Activate
Sheets("Sheet1").Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Birthdays_Events_Due"


Range("A1:F" & Total + 1).Value = myArray
Range("A1:F1").Font.Bold = True
Worksheets("Birthdays_Events_Due").Range("A:F").Columns.AutoFit

'Worksheets("Transport_Pending").range("A1:G" & Legalcases).VerticalAlignment = xlCenter
Worksheets("Birthdays_Events_Due").Range("E:E").HorizontalAlignment = xlCenter
Worksheets("Birthdays_Events_Due").Range("D:D").NumberFormat = "dd-mm-yyyy"

ActiveWorkbook.SaveAs ("F:\Corporate\Anshika\Due Dates\sent\" & Report)



End Sub


Sub UPDATE_BIRTHDAYS()
'
' UpdateBirthdays Macro
'

'
Worksheets("Database").Activate
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:= _
Array("BIRTHDAY", "CELEBRATIONS", "ANNIVARSARY"), Operator:=xlFilterValues
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
"OVERDUE"
ActiveWindow.SmallScroll Down:=-21
Columns("E:E").Select
Selection.Replace What:=Year(Now()), Replacement:=Year(Now()) + 1, LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=7
'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3
ActiveSheet.AutoFilter.ShowAllData
Worksheets("DATABASE").Activate
End Sub
 
Upvote 0
anshikam said:
Please find below the code. Th code also sends out an email with teh excel file attachment however have not added that on here.
Code works fine with just "BIRTHDAYS" however not with multiple conditions.


Sub BIRTHDAYS()

Workbooks("DD DATABASE.xlsm").Activate
Worksheets("DATABASE").Activate

Call UPDATE_BIRTHDAYS

Dim record_count As Integer
record_count = WorksheetFunction.CountA(Range("b:b"))
record_count = record_count + 1

'MsgBox record_count

Dim ColCat3 As Integer
Dim ColCat1 As Integer
Dim ColDueDate As Integer
Dim CDueDays As Long
Dim ColCatStatus As Integer
Dim ColName As Integer
Dim ColDesignation As Integer
Dim ColBDR As Integer

ColCat3 = WorksheetFunction.Match("CATEGORY3", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColCat1 = WorksheetFunction.Match("CATEGORY1", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColDueDate = WorksheetFunction.Match("DUE*DATE", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
CDueDays = WorksheetFunction.Match("DUE*DAY*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColCatStatus = WorksheetFunction.Match("STATUS", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColName = WorksheetFunction.Match("*E*C*NAME*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColDesignation = WorksheetFunction.Match("*DESIGNATION*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)
ColBDR = WorksheetFunction.Match("*Birthday*Reminder*", ActiveWorkbook.Sheets("DATABASE").Range("1:1"), 0)

Dim Cat3 As String
Dim Cat1 As String
Dim Duedate As Date
Dim DueDays As Long
Dim Status As String
Dim Name As String
Dim Designation As String

Dim Total As Integer
Total = WorksheetFunction.CountIfs(Range("c:c"), "BIRTHDAY", Range("c:c"), "CELEBRATIONS", Range("C:C"), "ANNIVARSARY")
MsgBox "Total : " & Total

'WorksheetFunction.Countifs(Worksheets("C&P Output").Range("Ayg3:Ayg10000"), "<" & A100, Worksheets("C&P Output").Range("Ayg3:Ayg10000"), ">" & B100)

Dim J As Integer
J = 2
Dim Z As Integer
Z = 1
'MsgBox j & " " & ColCatStatus
Do While J <= record_count
'Dim Value As String
'Value = Cells(j, ColCat2).Value
'MsgBox Value

If Cells(J, ColCat3).Value = "BIRTHDAY" Or Cells(J, ColCat3).Value = "ANNIVARSARY" Or Cells(J, ColCat3).Value = "CELEBRATIONS" And Cells(J, ColBDR).Value = "Y" Then
'MsgBox "value found"
Dim cell As String
cell = Cells(J, ColCatStatus).Value
'MsgBox j & " " & ColCatStatus & " " & cell
If Cells(J, ColCatStatus).Value = "DUE" Or Cells(J, ColCatStatus).Value = "OVERDUE" Or Cells(J, ColCatStatus).Value = "DUE DATE PENDING" Or Cells(J, ColCatStatus).Value = "DUE TODAY" Then

Cat3 = Cells(J, ColCat3).Value
Cat1 = Cells(J, ColCat1).Value
Duedate = Cells(J, ColDueDate).Value
DueDays = Cells(J, CDueDays).Value
Status = Cells(J, ColCatStatus).Value
Name = Cells(J, ColName).Value
Designation = Cells(J, ColDesignation).Value

'MsgBox Cat2 & vbCrLf & Cat3 & vbCrLf & Duedate & vbCrLf & vbCrLf & Status & vbCrLf & Courtcase
Dim myArray(500, 6) As Variant
myArray(0, 0) = "CATEGORY3"
myArray(0, 1) = "CATEGORY1"
myArray(0, 2) = "DUE DATE"
myArray(0, 3) = "DUE DAYS"
myArray(0, 4) = "STATUS"
myArray(0, 5) = "NAME"
myArray(0, 6) = "DESIGNATION"

myArray(Z, 0) = Cat3
myArray(Z, 1) = Cat1
myArray(Z, 2) = Duedate
myArray(Z, 3) = DueDays
myArray(Z, 4) = Status
myArray(Z, 5) = Name
myArray(Z, 6) = Designation

'MsgBox "Value stored in MyArray record " & vbCrLf & MyArray(0, 0) & " " & MyArray(z, 0) & vbCrLf & MyArray(0, 1) & " " & MyArray(z, 1) & vbCrLf & MyArray(0, 2) & " " & MyArray(z, 2) & vbCrLf & MyArray(0, 3) & " " & MyArray(z, 3) & vbCrLf & MyArray(0, 4) & " " & MyArray(z, 4) & vbCrLf & MyArray(0, 5) & " " & MyArray(z, 5)
Z = Z + 1
End If
End If
J = J + 1
'MsgBox j & " " & ColCatStatus
Loop
Dim Report As String
Dim CDateTime As String
CDateTime = Day(Now()) & Month(Now()) & Year(Now()) & "_" & Hour(Now()) & Minute(Now()) & Second(Now())
Report = "Birthdays_Events_Due" & CDateTime & ".xls"
Dim Path As String
Path = "F:\Corporate\Anshika\Due Dates\sent\"
Workbooks.Add.SaveAs Filename:=Path & Report


Workbooks(Report).Activate
Sheets("Sheet1").Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Birthdays_Events_Due"


Range("A1:F" & Total + 1).Value = myArray
Range("A1:F1").Font.Bold = True
Worksheets("Birthdays_Events_Due").Range("A:F").Columns.AutoFit

'Worksheets("Transport_Pending").range("A1:G" & Legalcases).VerticalAlignment = xlCenter
Worksheets("Birthdays_Events_Due").Range("E:E").HorizontalAlignment = xlCenter
Worksheets("Birthdays_Events_Due").Range("D:D").NumberFormat = "dd-mm-yyyy"

ActiveWorkbook.SaveAs ("F:\Corporate\Anshika\Due Dates\sent\" & Report)



End Sub


Sub UPDATE_BIRTHDAYS()
'
' UpdateBirthdays Macro
'

'
Worksheets("Database").Activate
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:= _
Array("BIRTHDAY", "CELEBRATIONS", "ANNIVARSARY"), Operator:=xlFilterValues
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
"OVERDUE"
ActiveWindow.SmallScroll Down:=-21
Columns("E:E").Select
Selection.Replace What:=Year(Now()), Replacement:=Year(Now()) + 1, LookAt:=xlPart, _
Searchorder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=7
'ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3
ActiveSheet.AutoFilter.ShowAllData
Worksheets("DATABASE").Activate
End Sub
Click to expand...
FormR provided a answer to your orignal question.
Add his solution to your script
 
Upvote 0
FormR said:
The criteria in COUNTIFS() are AND's - a cell can't contain all three of the criteria.

You could try:

total = Application.Sum(Application.CountIfs(Range("C:C"), Array("ANNIVARSARY", "CELEBRATIONS", "BIRTHDAY")))

Or in a slightly shorter form.

total = [SUM(COUNTIFS(C:C,{"ANNIVARSARY","CELEBRATIONS","BIRTHDAY"}))]
Click to expand...
That works for me. Thanks for that solution
 
Upvote 0
FormR said:
The criteria in COUNTIFS() are AND's - a cell can't contain all three of the criteria.

You could try:

total = Application.Sum(Application.CountIfs(Range("C:C"), Array("ANNIVARSARY", "CELEBRATIONS", "BIRTHDAY")))

Or in a slightly shorter form.

total = [SUM(COUNTIFS(C:C,{"ANNIVARSARY","CELEBRATIONS","BIRTHDAY"}))]
Click to expand...
This worked Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
COUNTIF to count cells with conditional formatting
Replies
8
Views
336
Peter_SSs
Peter_SSs
B
  • Solved
Count Coloured cells
2
Replies
10
Views
388
baileyb103
B
C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
R
  • Question
Trying to write VBA script for the choosecols and filter function in Excel
Replies
1
Views
123
StephenCrump
S
B
  • Question
countifs question
Replies
9
Views
398
DanteAmor
DanteAmor

Forum statistics

Threads
1,214,925
Messages
6,122,303
Members
449,078
Latest member
nonnakkong

Share this page

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
Back
Top