Excel VBA macro highlight break in attendance / gap in dates

Query: I have downloaded attendance data/log from application employee wise, I want to highlight break days. e.g. if an employee has worked from 1 to 15th , and his next attendance is on 22nd I want to highlight 22nd and similar such data. Also there 5 working days for some employees & 6 working days for others. All Sundays are compulsory holidays & Saturday is extra holidays for those who are working for 5 days.

Data format is as below:

Solution:

Again we will use VBA to get work done, sequence will be :

Read EmpID & Date into array,
Sort array EmpID wise & then date wise using bubble sort method.
Now loop through value in array & check for break.

Code goes here:

Sub spot_break_rev()

Dim Arr() As Variant
Dim Temp As Variant
Dim Txt As String
Dim i As Long
Dim j As Long
Dim lr As Long
Dim k As Long

lr = Range("A" & Rows.Count).End(xlUp).Row
    
With Cells.Interior
     .Pattern = xlNone
     .TintAndShade = 0
     .PatternTintAndShade = 0
End With
    
'Allocate value to dynamic array
ReDim Arr(0 To lr - 2)
    
'Fill the array with the keys from the Dictionary
For i = 0 To lr - 2
    Arr(i) = Cells(i + 2, "A") & "^" & Cells(i + 2, "C") & "~" & i + 2
Next i
    
'Sort the array using the bubble sort method
'Sory by emp code
For i = LBound(Arr) To UBound(Arr) - 1
    For j = i + 1 To UBound(Arr)
        If Arr(i) > Arr(j) Then
           Temp = Arr(j)
           Arr(j) = Arr(i)
           Arr(i) = Temp
           End If
    Next j
Next i

'Sort the array using the bubble sort method
'Sory by date if any left out
For i = LBound(Arr) To UBound(Arr) - 1
    For j = i + 1 To UBound(Arr)
    If Split(Arr(i), "^")(0) = Split(Arr(j), "^")(0) Then
           If Split(Arr(i), "^")(0) > Split(Arr(j), "^")(0) Then
           Temp = Arr(j)
           Arr(j) = Arr(i)
           Arr(i) = Temp
           End If
    End If
    Next j
Next i

For i = LBound(Arr) To UBound(Arr) - 1
    k = 0
    If Split(Arr(i), "^")(0) = Split(Arr(i + 1), "^")(0) Then
       If (CDate(Split(Split(Arr(i), "^")(1), "~")(0)) + 1) * 1 <> _
          (CDate(Split(Split(Arr(i + 1), "^")(1), "~")(0))) * 1 Then
          If Day(CDate(Split(Split(Arr(i + 1), "^")(1), "~")(0))) <> 7 Then
             If Cells(Split(Arr(i + 1), "~")(1), "D") <> 6 Then 'chage column no. of days
             Cells(Split(Arr(i + 1), "~")(1), "A").EntireRow.Interior.Color = vbYellow
             End If
          End If
       End If
       k = k + 1
    End If
    If k = 0 Then
    Cells(Split(Arr(i), "~")(1), "A").EntireRow.Interior.Color = vbYellow
    End If
    If k = 0 And i = UBound(Arr) - 1 Then
    Cells(Split(Arr(i), "~")(1) + 1, "A").EntireRow.Interior.Color = vbYellow
    End If
    
Next i

End Sub

You can download file from here:

Provide us your valuable feedback & post your query on www.ExcelVbaLab.Com

Cheers!!