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