I'm trying to convert a COUNTIF into a COUNTIFS where the criteria would be a dynamic range made by typing a "y" for yes in col A next to a student misbehavior in col B.
Teachers would log student misbehaviors using data validation lists in a student information sheet. In the student info sheet (sheet14 in this example), note that the odd rows pertain to the misbehaviors, and the even rows pertain to missing assignments. We want Excel to only tally the misbehavior info if a student reaches 5 of any misbehaviors marked as "y" in the sheet named Lookups. And, we want Excel to overlook any cell that is already filled with yellow color.
I can make this work by typing literal OR criteria, such as "locker" in the code below, but I can't figure out how to make this work using the yes/no list on the other sheet. Any help would be GREATLY appreciated. Thanks so much!
Sub Q1_Email_Student_Info()
On Error GoTo ClearError
Dim cell As Range, studentCell As Range
Dim ci As Long
Dim str As String
Dim emailRng As Range, cl As Range, ce As Range
Dim sTo As String
Set emailRng = Worksheets("EmailRecipients").Range("B1:B10")
Dim emailyesno As Range
Set emailyesno = Worksheets("EmailRecipients").Range("A1:A10")
sTo = ""
Dim misbehaveyesno As Range
Set misbehaveyesno = Worksheets("Lookups").Range("A1:A10")
sBad = ""
For Each cell In emailyesno.Cells
If (LCase(cell.Value) = "y") Then
sTo = sTo & ";" & cell.Offset(0, 1).Value
End If
Next cell
'**TRYING TO USE SOMETHING LIKE THIS FOR THE COUNTIFS BELOW
For Each cell In misbehaveyesno.Cells
If (LCase(cell.Value) = "y") Then
sBad = cell.Offset(0, 1).Value
End If
Next cell
Application.EnableEvents = False
Application.ScreenUpdating = False
str = "5th Grade Students - " & Date & vbCr
For Each cell In Sheet14.Range("C4:ZZ100").Cells
ci = cell.Interior.ColorIndex
If Not (ci = 6) And Not IsNumeric(cell.Value) Then
'****************************************************************************
Set studentCell = Sheet14.Cells(cell.Row, "A")
With cell
If cell.Row Mod 2 = 0 Then
If Not .CommentThreaded Is Nothing Then
str = str & studentCell.Value & " - Missing: " & .CommentThreaded.Text & " (Staff: " & CStr(.Value) & ")" & vbCr
ElseIf Not .Comment Is Nothing Then
str = str & studentCell.Value & " - Missing: " & .Comment.Text & " (Staff: " & CStr(.Value) & ")" & vbCr
Else
str = str & studentCell.Value & " (Staff: " & CStr(.Value) & ")" & vbCr
End If
Else
'**TRYING TO CONVERT THIS COUNTIF INTO A COUNTIFS WITH CRITERIA THAT ARE TOGGLED ON IN THE LOOKUPS SHEET.
'**TRYING TO USE MULTIPLE BEHAVIOR CRITERIA ONLY MARKED "Y" ON THE LOOKUPS SHEET
'**IF THERE ARE 5 OR MORE INSTANCES OF CRITERIA MARKED "Y" AND COLORED NOT YELLOW, THEN COUNT AND INCLUDE THEM.
If WorksheetFunction.CountIf(cell.EntireRow, "locker") >= 5 Then
If Not .CommentThreaded Is Nothing Then
str = str & studentCell.Value & " - Behavior: " & CStr(.Value) & " (Staff: " & .CommentThreaded.Text & ")" & vbCr
ElseIf Not .Comment Is Nothing Then
str = str & studentCell.Value & " - Behavior: " & CStr(.Value) & " (Staff: " & .Comment.Text & ")" & vbCr
Else
str = str & studentCell.Value & " - Behavior: " & CStr(.Value) & vbCr
End If
End If
End If
End With
'****************************************************************************
End If
Next cell
str = str & vbCr & "6th Grade Students - " & Date & vbCr
For Each cell In Sheet4.Range("C4:ZZ100").Cells
ci = cell.Interior.ColorIndex
If Not (ci = 6) And Not IsNumeric(cell.Value) Then
'****************************************************************************
Set studentCell = Sheet4.Cells(cell.Row, "A")
With cell
If cell.Row Mod 2 = 0 Then
If Not .CommentThreaded Is Nothing Then
str = str & studentCell.Value & " - Missing: " & .CommentThreaded.Text & " (Staff: " & CStr(.Value) & ")" & vbCr
ElseIf Not .Comment Is Nothing Then
str = str & studentCell.Value & " - Missing: " & .Comment.Text & " (Staff: " & CStr(.Value) & ")" & vbCr
Else
str = str & studentCell.Value & " (Staff: " & CStr(.Value) & ")" & vbCr
End If
Else
If Not .CommentThreaded Is Nothing Then
str = str & studentCell.Value & " - Behavior: " & CStr(.Value) & " (Staff: " & .CommentThreaded.Text & ")" & vbCr
ElseIf Not .Comment Is Nothing Then
str = str & studentCell.Value & " - Behavior: " & CStr(.Value) & " (Staff: " & .Comment.Text & ")" & vbCr
Else
str = str & studentCell.Value & " - Behavior: " & CStr(.Value) & vbCr
End If
End If
End With
'****************************************************************************
End If
Next cell
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sTo
.CC = ""
.BCC = ""
.Subject = "Daily Behavior and Missing Work Report, " & Date & ", Q1"
'****************************************************************************
Dim wdDoc As Object
Dim olinsp As Object
Set wdDoc = CreateObject("Word.Document")
Set olinsp = .GetInspector
Set wdDoc = olinsp.WordEditor
If Not IsEmpty(str) Then
wdDoc.Range.InsertBefore str
Else
MsgBox prompt:="No cells meet the criteria"
GoTo SafeExit
End If
'****************************************************************************
.Display
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
Set wdDoc = Nothing
Set olinsp = Nothing
str = Empty
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error'" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call ThisWorkbook.Check_Outlook
With Target
Select Case .Address
Case "$A$1":
Call Q1_Email_Student_Info
End Select
End With
Cancel = True
End Sub
========================REVISED 7/2============================
I found a workaround after studying a number of other posts. I still haven't figured out how to build in a "YES/NO" list on another sheet to add/remove misbehaviors.
The post I mainly used was Excel Countifs formula with one color criteria and the rest normal. Here is how I modified it...
In each worksheet's code, I inserted this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Calculate
End Sub
I also changed the code that I previously posted (see below for revisions). Note that I've also added a column A, shifting the list of student names to col B (for something that I'm planning on next). Also, I added a new column D to contain the values of the COUNTIF(), which are auto-updated on the worksheet_selectionchange. I'm using these values (if >= 5) to include a misbehavior reminder for teachers in the email.
For Each cell In Sheet3.Range("C4:ZZ100").Cells
ci = cell.Interior.ColorIndex
If Not (ci = 6) And Not IsNumeric(cell.Value) Then
'****************************************************************************
Set studentCell = Sheet3.Cells(cell.Row, "A")
With cell
If cell.Row Mod 2 = 0 Then
If Not .CommentThreaded Is Nothing Then
str = str & studentCell.Value & " - Missing: " & .CommentThreaded.Text & " (Staff: " & CStr(.Value) & ")" & vbCr
ElseIf Not .Comment Is Nothing Then
str = str & studentCell.Value & " - Missing: " & .Comment.Text & " (Staff: " & CStr(.Value) & ")" & vbCr
End If
End If
End With
End If
Next cell
For Each cell In Sheet3.Range("C4:C100").Cells
Set studentCell = Sheet3.Cells(cell.Row, "A")
Set countCell = Sheet3.Cells(cell.Row, "C")
If countCell.Value >= 5 Then
str = str & vbCr & studentCell.Value & " - End of line today due to " & CStr(countCell.Value) & " locker trips."
End If
Next cell
I am not very experienced with Excel VBA, so I'm sure I'm missing ways to refactor this.
In Module 1, I inserted the following code. It will overlook any cells that are filled yellow, which is the color that shows us teachers that we've already dealt with a student's behaviors.
Function CountColors(TheRange As Range, TheColor As Range) As Long
Application.Volatile
Dim c As Range
Dim color As Long
Dim cellcount As Long
color = TheColor.Interior.ColorIndex
For Each c In TheRange
If c.Value = "locker" And c.Interior.ColorIndex = color Then
cellcount = cellcount + 1
End If
Next
CountColors = cellcount
End Function
Lastly, in the odd cells of column D, I entered the CountColors() function: =CountColors(E5:BA5,C5). It's working for now, but it'd be great to be able to somehow automate it with a Y/N toggle rather than having to type a Boolean OR in the CountColors function. Thanks again.
