sick record

[ksp]

Hi all, need the grps help for a code. I have staff name, date of leaves taken and a column stating kind of leave. I want to know the no.of instances a particular employee has taken a sick leave. If the dates arecconsecutive it should count as 1 instance and if there is gap in dates it should second instance.
Thank you

[Yongle]

Welcome to the forum
We need to see how the information is stored in the worksheet to help you
Click on "GoAdvanced" and then on the "paperclip" icon to attach your workbook. Leave all the data and headers unchanged. But change the names if you want to keep those confidential
thanks

[ksp]

Hi Yongle, thnks for extending a helping hand, attached for your reference a workbook with details. As mentioned want to find out a code in vba to count the total Sick leave counts for each person and separately the number of instances. So consecutive days would make one instance and count of 2 leaves.

[ksp]

So taking the eg of the first name... the person has had 5 leaves...however the instances would be 4. For second name, leaves will be 3 with 2 instances...

[Paul_Hossler]

You didn't say how to report so I just added in the next 2 columns







Option Explicit

Sub Macro1()
Const constID As Long = 1
Const constDate As Long = 5
Const constInstances As Long = 6
Const constDays As Long = 7

Dim rSickLeaves As Range, rSickLeavesNoHeader As Range

Dim iRow As Long, iDays As Long, iInstances As Long

'set the data
Set rSickLeaves = ActiveSheet.Cells(1, 1).CurrentRegion
Set rSickLeavesNoHeader = rSickLeaves.Cells(2, 1).Resize(rSickLeaves.Rows.Count - 1, rSickLeaves.Columns.Count)

'sort to be sure
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=rSickLeavesNoHeader.Columns(constID), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=rSickLeavesNoHeader.Columns(constDate), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rSickLeaves
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

iInstances = 0
iDays = 0
With rSickLeaves
For iRow = .Rows.Count To 2 Step -1

'same ID in N and N-1?
If .Cells(iRow, constID).Value = .Cells(iRow - 1, constID).Value Then
iDays = iDays + 1
'Date in N not the date after date in N-1?
If .Cells(iRow, constDate).Value <> .Cells(iRow - 1, constDate).Value + 1 Then
iInstances = iInstances + 1
End If

'new ID, so write counts and re-init
Else
.Cells(iRow, constInstances).Value = iInstances + 1
.Cells(iRow, constDays).Value = iDays + 1
iInstances = 0
iDays = 0
End If
Next iRow
End With

End Sub

[ksp]

Hi Paul, thank you so much. This is going to help me immensely in my day to day work. Thank you again.

[SamT]

Just so you know, you can use the "Thread Tools" dropdown to mark your theads solved.