Macro or Formula Absence report

[LegenDSlayeR]

Hi all

i need a little help. not sure if it can be done or not. i want to simplify staff absences. for example

Emp Code	Forename	Name	Job Title	Days	Start	End Date	Hours	Re Co	Absence Reason
000160​	Person	One	CSA	1​	12/10/2021​	12/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	13/10/2021​	13/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	14/10/2021​	14/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	15/10/2021​	15/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	2​	16/10/2021​	17/10/2021​
000160​	Person	One	CSA	1​	18/10/2021​	18/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	19/10/2021​	19/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	20/10/2021​	20/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	21/10/2021​	21/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	22/10/2021​	22/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	2​	23/10/2021​	24/10/2021​
000160​	Person	One	CSA	1​	25/10/2021​	25/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	26/10/2021​	26/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	27/10/2021​	27/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	28/10/2021​	28/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	29/10/2021​	29/10/2021​	7:00	MS	Covid
000160​	Person	One	CSA	2​	30/10/2021​	31/10/2021​
000160​	Person	One	CSA	1​	01/11/2021​	01/11/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	02/11/2021​	02/11/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	03/11/2021​	03/11/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	04/11/2021​	04/11/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	05/11/2021​	05/11/2021​	7:00	MS	Covid
000160​	Person	One	CSA	2​	06/11/2021​	07/11/2021​
000160​	Person	One	CSA	1​	08/11/2021​	08/11/2021​	7:00	MS	Covid
000160​	Person	One	CSA	1​	09/11/2021​	09/11/2021​	7:00	MS	Covid
000498​	Colleague	Two	CSA	1​	13/11/2020​	13/11/2020​	5:00	HM	Headache/Migraine
000498​	Colleague	Two	CSA	1​	28/04/2021​	28/04/2021​	5:00	BP	Back Problems
000498​	Colleague	Two	CSA	0.4​	15/02/2022​	15/02/2022​	2:00	GD	Sickness bug
000498​	Colleague	Two	CSA	1​	16/02/2022​	16/02/2022​	5:00	GD	Sickness bug
000498​	Colleague	Two	CSA	1​	17/02/2022​	17/02/2022​
000498​	Colleague	Two	CSA	1​	18/02/2022​	18/02/2022​	5:00	GD	Sickness bug

Person one has had 25 days off in a row i want to be able make that into one line from the start date 21/10/2021 to the end date 09/11/2021 with the amount of days had off which is 25.
Colleague Two has had 3 different absences i need this to show 3 lines so headache would be one line, back problems would be a line, and sickness bug would be a line. which all need start and end date.

hope this makes sense. and is this possible ??

Regards

Jamie

 

[sijpie]

Sure is possible. Thanks for the clear question and example table.
I am assuming you want the results in a separate table, not overwriting the original

 

[sijpie]

The code below gives the following output:

mp Code	Forename	Name	Job Title	Days	Start	End Date	Hours	Re Co	Absence Reason
000160	Person	One	CSA	28​	12/10/2021​	09/11/2021​	147​	MS	Covid
000498	Colleague	Two	CSA	1​	13/11/2021​	13/11/2021​	5​	HM	Headache/Migraine
000498	Colleague	Two	CSA	1​	28/04/2021​	28/04/2021​	5​	BP	Back Problems
000498	Colleague	Two	CSA	1​	15/02/2022​	16/02/2022​	7​	GD	Sickness bug
000498	Colleague	Two	CSA	1​	17/02/2022​	17/02/2022​	0​
000498	Colleague	Two	CSA	1​	18/02/2022​	18/02/2022​	5​	GD	Sickness bug

The sickness bug comes on three lines as one (17th) does not have any information.

I can change that, but I am wondering if I then create too many exceptions.

Run it and see what you think. You need to run it from the sheet with the raw data

Option Explicit

Sub SickLeaveTable()
    Dim vIn As Variant, vOut As Variant
    Dim lRi As Long, lC As Long, lRo As Long, UB1 As Long, UB2 As Long, lRchk As Long
    Dim wsOut As Worksheet
    Dim rTable As Range
    Dim sEmplNr As String, sReason As String
    Dim dTotHrs As Double
    
    Set rTable = Range("A1").CurrentRegion  '<<<<< Modify to top left cell of input table
    
    vIn = rTable.Value
    UB1 = UBound(vIn, 1): UB2 = UBound(vIn, 2)
    
    ReDim vOut(1 To UB1, 1 To UB2)
    
    'copy header row
    For lC = 1 To UB2
        vOut(1, lC) = vIn(1, lC)
    Next lC
    
    lRo = 2
    'process data
    For lRi = 2 To UB1
        sEmplNr = vIn(lRi, 1)   ' 1st column employer nr
        sReason = vIn(lRi, 10)  ' 10th column reason
        For lC = 1 To UB2
            vOut(lRo, lC) = vIn(lRi, lC)
        Next lC
        For lRchk = lRi + 1 To UB1
            If (vIn(lRchk, 1) Like sEmplNr) And ((vIn(lRchk, 10) Like sReason) Or (vIn(lRchk, 10) = "" And vIn(lRchk, 5) = 2)) Then
                dTotHrs = dTotHrs + vIn(lRchk, 8) 'hrs in 8th column
            Else
                Exit For
            End If
        Next lRchk
        lRchk = lRchk - 1   ' last row with same employee and reason
        If lRchk > lRi Then
            vOut(lRo, 8) = vOut(lRo, 8) + dTotHrs  ' total hours in dateformat
            vOut(lRo, 5) = vIn(lRchk, 6) - vIn(lRi, 6) 'total days
            vOut(lRo, 7) = CDate(vOut(lRo, 7) + vOut(lRo, 5))
            lRi = lRchk
        End If
        vOut(lRo, 8) = vOut(lRo, 8) * 24 ' total hours in hours
        lRo = lRo + 1
        dTotHrs = 0
    Next lRi
    
    Set wsOut = Sheets.Add(after:=Sheets(Sheets.Count))
    
    With wsOut
        .Name = "SickLeaveRprt-" & Format(Now, "ddmmyy-hh.mm")
        .Range("A1").Resize(UB1, UB2).Value = vOut
    End With
End Sub