In our below example we have a data of attendance roster from 01 Jan 2018 to 31 Jan 2018.
The attendance roster has the below legends.
The macro first calculates the total number of P, A, WO, OD .
To arrive at paid days the macro uses the below formula.
E.g For the month of April ( Total Month Days are 30)
Hence the sum of Present Days , Week Off, Outdoor and Absent should be equal to 30. If it is not equal to 30 then some value has been missed.
Some organisations have salary cuts for late marks if the employee does not have leave balance. In such case an additional parameter for late mark should be included in addition to ( P , WO , OD, A).
The macro further uses conditional formatting to highlight all the absent in the attendance roster in red color.
Some additional formatting like font, border, and interior color are applied to various cell ranges.
Download Code_Attendence Macro
Download Excel Macro Attendance
Sub calculate_attendance() wsroster.Activate Dim p_range As Range Dim a_range As Range Dim wo_range As Range Dim od_range As Range Dim cr_range As Range Dim countrows As Integer Dim first_counterp As Integer Dim paid_range As Range '' Count no of employee countrows = Application.WorksheetFunction.CountA _ (Range("A5", Range("A" & Rows.Count).End(xlUp))) '' Main Range Set cr_range = Range("g5", Range("g5").End(xlToRight)) ' Criteria Count Set p_range = Range("b5") Set a_range = Range("c5") Set wo_range = Range("d5") Set od_range = Range("e5") Set paid_range = Range("f5") 'COUNT PRESENT DAYS first_counterp = 0 Do 'countif the criteria and publish results p_range = Application.WorksheetFunction.CountIf(cr_range, "P") a_range = Application.WorksheetFunction.CountIf(cr_range, "a") wo_range = Application.WorksheetFunction.CountIf(cr_range, "wo") od_range = Application.WorksheetFunction.CountIf(cr_range, "od") paid_range.Value = (p_range.Value + a_range.Value + wo_range.Value + od_range.Value) - a_range.Value paid_range.Interior.ColorIndex = 36 'increase the counter first_counterp = first_counterp + 1 ''set focus cell on the next criteria answer Set p_range = p_range.Offset(1, 0) Set a_range = a_range.Offset(1, 0) Set wo_range = wo_range.Offset(1, 0) Set od_range = od_range.Offset(1, 0) Set paid_range = paid_range.Offset(1, 0) 'move to next record Set cr_range = cr_range.Offset(1, 0) Set cr_range = Range(cr_range, cr_range.End(xlToRight)) Loop While first_counterp <> countrows '' format cells Dim frm_range1 As Range Dim frm_range2 As Range Dim frm_range3 As Range Dim cf_range1 As Range Set frm_range1 = Range("A5", Range("A5").End(xlDown).End(xlToRight)) frm_range1.Borders(xlEdgeLeft).LineStyle = xlcontinous frm_range1.Borders(xlEdgeRight).LineStyle = xlcontinous frm_range1.Borders(xlEdgeTop).LineStyle = xlcontinous frm_range1.Borders(xlEdgeBottom).LineStyle = xlcontinous frm_range1.Borders(xlInsideHorizontal).LineStyle = xlDot frm_range1.Borders(xlInsideVertical).LineStyle = xlDot frm_range1.Borders(xlEdgeLeft).Weight = xlThick frm_range1.Borders(xlEdgeRight).Weight = xlThick frm_range1.Borders(xlEdgeTop).Weight = xlThick frm_range1.Borders(xlEdgeBottom).Weight = xlThick frm_range1.Borders(xlInsideHorizontal).Weight = xlThin frm_range1.Borders(xlInsideVertical).Weight = xlThin Set frm_range2 = Range("B4:E4") frm_range2.Font.Bold = True frm_range2.Borders.LineStyle = xlcontinous frm_range2.Interior.ColorIndex = 40 Set frm_range3 = Range("G4", Range("g4").End(xlToRight)) frm_range3.Borders.LineStyle = xlcontinous frm_range3.Interior.ColorIndex = 22 frm_range3.Font.Bold = True Range("a4").Interior.ColorIndex = 50 Range("a4").Font.Bold = True Range("f4").Interior.ColorIndex = 44 Range("f4").Font.Bold = True Range("A1:B1").Font.Bold = True Range("A1:B1").Borders.LineStyle = xlcontinous Range("A1:B1").Borders.Weight = xlThick Range("A1:B1").Interior.ColorIndex = 24 ' Set conditional formatting ' Select Range Set cf_range1 = Range("G5", Range("G5").End(xlDown).End(xlToRight)) cf_range1.Select ' Specify Parameter Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""A""" Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1).Font .Color = -16383844 .TintAndShade = 0 End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 13551615 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False Range("A1").Select End Sub Sub clearatt() [att_cal].ClearContents End Sub