Forum Discussion
Needs Help on the VBA for an Attendance Sheet
Hi!
I need to create a new routine so that it will highlight in the "Summary" sheet in
i) red for courses that the staff has not attended after the deadline has passed, and
ii) yellow for courses that the staff has attended but only after the deadline has passed.
This has to be based on the "Attendance List" sheet
Attached is the excel file.
Any help is much appreciated!! 
Btw, I know how to do it using conditional formatting but I need to create a VBA for other purposes as well.
https://docs.google.com/spreadsheets/d/1R-BrDQG_cJ0I0BzL_oIPVk8IGFFUbn77AoGFFmV1mBs/edit?usp=sharing
10 Replies
Hi Ong Zhen
Find the explanation in the code comments
Option Explicit
Sub checkAttendance()
Dim sWs As Worksheet
Dim aWs As Worksheet
Set sWs = Worksheets("Summary")
Set aWs = Worksheets("Attendance list")
Dim columnNo As ByteDim NoNames As Long
Dim c As LongWith sWs
'counts number of names
NoNames = .Cells(50000, 1).End(xlUp).Row - 1
'looping through column 3 to 5 (C, D, E)
For columnNo = 3 To 5 Step 1
'clean previous highlights to start from scratch
.Range(.Cells(2, columnNo), .Cells(NoNames + 1, columnNo)).Interior.Color = xlNone
'going through each name
For c = 1 To NoNames
' ignore cells without course name
If Trim(.Cells(c + 1, columnNo)) <> "" Then
' checking whether name exist in attendance sheet
If Application.WorksheetFunction.CountIfs(aWs.Columns(1), .Cells(c + 1, 1).Value) = 0 Then
'write code here if you want highlight names that do not exist in the attendance list
Else
' apply cells colours according to the guidelines
If Application.WorksheetFunction.CountIfs(aWs.Columns(1), .Cells(c + 1, 1).Value, aWs.Columns(2), .Cells(c + 1, columnNo).Value, aWs.Columns(3), ">" & .Cells(c + 1, 6).Value) = 1 Then
.Cells(c + 1, columnNo).Interior.ColorIndex = 6
ElseIf Application.WorksheetFunction.CountIfs(aWs.Columns(1), .Cells(c + 1, 1).Value, aWs.Columns(2), .Cells(c + 1, columnNo).Value) = 0 Then
.Cells(c + 1, columnNo).Interior.ColorIndex = 3
End If
End If
End If
Next c
Next columnNo
End WithEnd Sub
Tomasz Kocur Hi there! Thank you for your help!
The expected result is slightly different. For example, Alivin Kennedy should have the First Course and Second course to attend since he has not attended them based on the Attendance Sheet. Expected ResultsResults from Given Code
Hi ONG ZHEN
Yes you have right - please ignore the previous code and see below
Option Explicit
Sub checkAttendance()
Dim sWs As Worksheet
Dim aWs As Worksheet
Set sWs = Worksheets("Summary")
Set aWs = Worksheets("Attendance list")
Dim columnNo As ByteDim NoNames As Long
Dim c As LongDim coursDate As Date
With sWs
'counts number of names
NoNames = .Cells(50000, 1).End(xlUp).Row - 1
'looping through column 3 to 5 (step 1)
For columnNo = 3 To 5 Step 1
'clean previous highlights to start from scratch
.Range(.Cells(2, columnNo), .Cells(NoNames + 1, columnNo)).Interior.Color = xlNone
'going through each name
For c = 1 To NoNames
' ignore cells without course name
If Trim(.Cells(c + 1, columnNo)) <> "" Then
' checking whether name exist in attendance sheet
If Application.WorksheetFunction.CountIfs(aWs.Columns(1), .Cells(c + 1, 1).Value) = 0 Then
.Cells(c + 1, columnNo).Interior.ColorIndex = 3
Else
'taking data from attendance list
coursDate = Application.WorksheetFunction.SumIfs(aWs.Columns(3), aWs.Columns(1), .Cells(c + 1, 1).Value, aWs.Columns(2), .Cells(c + 1, columnNo).Value)
' apply cells colours according to the guidelines
If coursDate > CDate(.Cells(c + 1, 6)) Then
.Cells(c + 1, columnNo).Interior.ColorIndex = 6
ElseIf coursDate = 0 Then
.Cells(c + 1, columnNo).Interior.ColorIndex = 3
End If
End If
End If
Next c
Next columnNo
End WithEnd Sub
