Needs Help on the VBA for an Attendance Sheet

Brass Contributor

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 Byte

Dim NoNames As Long
Dim c As Long

With 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 With

End 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 ResultsExpected ResultsResults from Given CodeResults 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 Byte

Dim NoNames As Long
Dim c As Long

Dim 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 With

End Sub

 

@Tomasz Kocur Thank you so much! It works perfectly now! :)

@Tomasz Kocur ermm... I just realizederror.JPG that there is only one little problem left.. From row 103 and onwards, column C to E is highlighted in red the whole way down

not in my copy
NoNames = .Cells(50000, 1).End(xlUp).Row - 1�

is a calculating number of rows that macro is going through
try highlighting all rows below 103 and remove entire rows

https://drive.google.com/file/d/1j9iel09lSFb3kwa1o-bcu7yQ9rq1TEyw/view?usp=sharing

@Tomasz Kocur I found out what went wrong and it works fine now. Thanks for all of your help!! :)

@Tomasz Kocur I realized that there are a few mistakes. For example Capture.JPG

If you look at Row 6, Robyn Pierce had already attended the Customer Service before the deadline based on the attendance Sheet but Customer Service is still highlighted in Red.

Here become something more...
You need to have clean data... " Rudy Barnes" in the Attendance list tab has space in front of the name, while in the Summary tab is without space "Rudy Barnes"

 

There is always a possibility to add another loop that will go through each name and clean data from extra spaces or "non-printable characters" (which are quite often copied from servers reports or users interfaces)

@Tomasz Kocur Oh okay! I made sure of that and everything seems okay now :)