Find date range for sick leaves

Question

Hi,
Ive been trying to get readable output from HR system.
I have added the source data into Data Model, since i had to read the data with power query. Now i have pivot table like this:
date        workdaY?    user
6.3.2014    Sickleave    user1
1.2.2014    Sickleave    user2
2.2.2014    Sickleave    user2
5.3.2014    Sickleave    user4
5.3.2014    Sickleave    user1
5.5.2014    Sickleave    user1
16.9.2014  Sickleave    user3
7.3.2014    Sickleave    user1
6.5.2014    Sickleave    user1
6.3.2014    Sickleave    user4
Is there any possible way to get some kind of find function to sort and combine the data like this:
user1        Sickleave    5.3-7.3.2014
user1        Sickleave    5.5-6.5.2014
user2        Sickleave    1.2-2.2.2014
user3        Sickleave    16.9-16.9.2014
user4        Sickleave    5.3-6.3.2014

Answer 1

One way to do this is with a VBA macro.  The following should get you started.
As you can see looking at the macro, the original data is assumed to be on a worksheet named HRData and starts in A1.
The results are placed on the same worksheet but starting at cell G1.  You could easily write the results to another worksheet.
The original data is copied to a temporary worksheet for sorting (and the temporary sheet is subsequently deleted).
A Class Module is added so we can use a User Defined Object which has the properties of the user name, start date and end date of the vacation period.
We then cycle through the sorted data, and create a Sickleave object and add it to a collection.  If the "previous" row has the same user, and the date is one more than the previous End Date, we add one to the previous end date; if not, we
create a new object and start another sickleave period.
This is the data input:
and  here are the results:
To enter this Macro (Sub), <alt-F11> opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
First, from the top menu, select Insert/Class Module.  Highlight the new class module in the Project Explorer; click F4, and rename it to cSickLeave
Then paste the code below into that class module:
=======================================
Option Explicit
Private pUser As String
Private pStartDt As Date
Private pEndDt As Date
Public Property Get User() As String
User = pUser
End Property
Public Property Let User(Value As String)
pUser = Value
End Property
Public Property Get StartDt() As Date
StartDt = pStartDt
End Property
Public Property Let StartDt(Value As Date)
pStartDt = Value
End Property
Public Property Get EndDt() As Date
EndDt = pEndDt
End Property
Public Property Let EndDt(Value As Date)
pEndDt = Value
End Property
Then, from the top menu, select Insert/Module and
paste the code below into the regular module window that opens.
To use this Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro by name, and <RUN>.
====================================
Option Explicit
Option Compare Text
Sub SickLeave()
Dim cSL As cSickLeave, colSL As Collection
Dim wsSrc As Worksheet, wsRes As Worksheet
Dim wsTemp As Worksheet, rTemp As Range
Dim vSrc As Variant, rSrc As Range
Dim vRes() As Variant, rRes As Range
Dim I As Long
'set Worksheets
Set wsSrc = Worksheets("HRData")
With wsSrc
Set rSrc = .Range("A1", .Cells(.Rows.Count, "C").End(xlUp))
End With
Set wsRes = Worksheets("HRData")
Set rRes = wsRes.Range("G1") 'upper left cell of results
'Sort the HRdata on a Temp sheet
Worksheets.Add
Set wsTemp = ActiveSheet
Set rTemp = wsTemp.Range("A1")
rSrc.Copy rTemp
Set rTemp = rTemp.CurrentRegion
With rTemp
.Sort key1:=.Columns(3), order1:=xlAscending, _
key2:=.Columns(1), order2:=xlAscending, _
Header:=xlYes, MatchCase:=False
End With
vSrc = rTemp.Value
With Application
.ScreenUpdating = False
.DisplayAlerts = False
wsTemp.Delete
.DisplayAlerts = True
End With
'create collection for results
Set colSL = New Collection
For I = 2 To UBound(vSrc)
If vSrc(I, 2) = "Sickleave" Then
If I = 2 Then
Set cSL = New cSickLeave
With cSL
.User = vSrc(I, 3)
.StartDt = vSrc(I, 1)
.EndDt = vSrc(I, 1)
colSL.Add cSL
End With
ElseIf vSrc(I, 3) = colSL(colSL.Count).User And _
(vSrc(I, 1) - 1) = colSL(colSL.Count).EndDt Then
With colSL(colSL.Count)
.EndDt = .EndDt + 1
End With
Else
Set cSL = New cSickLeave
With cSL
.User = vSrc(I, 3)
.StartDt = vSrc(I, 1)
.EndDt = vSrc(I, 1)
colSL.Add cSL
End With
End If
End If
Next I
ReDim vRes(0 To colSL.Count, 1 To 3)
vRes(0, 1) = "User"
vRes(0, 2) = "workdaY?"
vRes(0, 3) = "Date Range"
For I = 1 To colSL.Count
With colSL(I)
vRes(I, 1) = .User
vRes(I, 2) = "Sickleave"
vRes(I, 3) = Format(.StartDt, "d.m\-") & _
Format(.EndDt, "d.m.yyyy")
End With
Next I
Set rRes = rRes.Resize(UBound(vRes) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
.EntireColumn.AutoFit
.Rows(1).HorizontalAlignment = xlCenter
End With
Application.ScreenUpdating = True
End Sub
Ron