Consolidate data set

[joelui]

hi guys,

I have a set of data with 1 row for each date/staff/event, is it possible to consolidate them so that it shows the start and end date if the staff number and the code are the same? if the dates break the sequence then I would like it to list as a separate row?

thanks,
Joe

e.g. Current data set

Staff Number	Start date	End date	Code
219	8-Jan-18	8-Jan-18	Leave
219	9-Jan-18	9-Jan-18	Leave
219	10-Jan-18	10-Jan-18	Leave
219	11-Jan-18	11-Jan-18	Leave
219	12-Jan-18	12-Jan-18	Leave
219	13-Jan-18	13-Jan-18	Leave
219	14-Jan-18	14-Jan-18	Leave
219	15-Jan-18	15-Jan-18	Leave
219	16-Jan-18	16-Jan-18	Leave
219	17-Jan-18	17-Jan-18	Leave
219	18-Jan-18	18-Jan-18	Leave
219	19-Jan-18	19-Jan-18	Leave
219	20-Jan-18	20-Jan-18	Leave
219	21-Jan-18	21-Jan-18	Leave
219	12-Feb-18	4-Mar-18	Leave
227	8-Jan-18	8-Jan-18	OFFLN
227	9-Jan-18	9-Jan-18	OFFLN
232	8-Jan-18	8-Jan-18	Leave
232	9-Jan-18	9-Jan-18	Leave
232	10-Jan-18	10-Jan-18	Leave
232	11-Jan-18	11-Jan-18	Leave
232	12-Jan-18	12-Jan-18	OFFLN
232	13-Jan-18	13-Jan-18	OFFLN
232	14-Jan-18	14-Jan-18	OFFLN

<tbody>
</tbody><colgroup><col><col><col span="2"></colgroup>

Consolidated data set:

Staff Number	Start date	End date	Code
219	8-Jan-18	21-Jan-18	Leave
219	12-Feb-18	4-Mar-18	Leave
227	8-Jan-18	9-Jan-18	OFFLN
232	8-Jan-18	11-Jan-18	Leave
232	12-Jan-18	14-Jan-18	OFFLN

<tbody>
</tbody><colgroup><col><col><col span="2"></colgroup>

 

[MickG]

Try this for results on sheet2.

[COLOR=navy]Sub[/COLOR] MG28Dec49
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] txt [COLOR=navy]As[/COLOR] [COLOR=navy]String,[/COLOR] q [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
ReDim Ray(1 To Rng.Count, 1 To 4)
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    txt = Dn.Value & "," & Dn.Offset(, 3).Value
    [COLOR=navy]If[/COLOR] Not .Exists(txt) [COLOR=navy]Then[/COLOR]
       ReDim nRay(1 To Rng.Count, 1 To 2)
        nRay(1, 1) = CDate(Dn.Offset(, 1).Value): nRay(1, 2) = CDate(Dn.Offset(, 2).Value)
        .Add txt, Array(nRay, 1)
    [COLOR=navy]Else[/COLOR]
        q = .Item(txt)
        q(1) = q(1) + 1
        q(0)(q(1), 1) = CDate(Dn.Offset(, 1).Value)
        q(0)(q(1), 2) = CDate(Dn.Offset(, 2).Value)
        .Item(txt) = q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, Dt [COLOR=navy]As[/COLOR] Date, temp [COLOR=navy]As[/COLOR] Date
c = 1
Ray(1, 1) = "Staff Number": Ray(1, 2) = "Start date": Ray(1, 3) = "End date": Ray(1, 4) = "Code"
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
c = c + 1
    [COLOR=navy]For[/COLOR] n = 1 To .Item(K)(1)
        [COLOR=navy]For[/COLOR] Dt = CDate(.Item(K)(0)(n, 1)) To CDate(.Item(K)(0)(n, 2))
            [COLOR=navy]If[/COLOR] Ray(c, 2) = "" [COLOR=navy]Then[/COLOR]
                Ray(c, 1) = Split(K, ",")(0)
                Ray(c, 2) = Format(Dt, "dd-mmm-yy")
            [COLOR=navy]ElseIf[/COLOR] Not DateAdd("d", 1, temp) = Dt [COLOR=navy]Then[/COLOR]
                c = c + 1
                Ray(c, 1) = Split(K, ",")(0)
                Ray(c, 2) = Format(Dt, "dd-mmm-yy") 
                Ray(c, 3) = Format(Dt, "dd-mmm-yy")
                Ray(c, 4) = Split(K, ",")(1)
            [COLOR=navy]Else[/COLOR]
                Ray(c, 3) = Format(Dt, "dd-mmm-yy")
                Ray(c, 4) = Split(K, ",")(1)
            [COLOR=navy]End[/COLOR] If
            temp = Dt
        [COLOR=navy]Next[/COLOR] Dt
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 4)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[joelui]

thanks so much for your help Mick

Regards,
Joe

 

[MickG]

You're welcome