Extracting Earliest and Latest Dates from Cells

[TheOddGirl]

I have a spreadsheet with 20,000 rows of data that I need to get the earliest and latest dates into one row.

Example, for Shop1 I would need the start date to be 01/01/2018 and the end date to be 05/04/2018 recorded in a column to the right so I can sort by that column and get rid of data that I don’t need. Can anyone offer any help with this please?

ShopID	ShopName	Startdate	Enddate
1	Name1	01/01/2018	05/02/2018
1	Name1	01/03/2018	05/04/2018
2	Name2	01/01/2017	05/02/2017
2	Name2	01/07/2017	05/09/2017
9	Name3	01/01/2018	28/02/2018
9	Name3	01/03/2018	30/10/2018

<tbody>
</tbody>

 

[Aladin Akyurek]

If MINIFS and MAXIFS functions are available on your system...

In E2 enter and copy down:

=MINIFS(C:C,A:A,A2)

In F2 enter and copy down:

=MAXIFS(D:D,A:A,$A2)

Otherwise, control++shift+enter, not just enter, and copy down:

E2 >>

=MIN(IF($A$2:$A$7=$A2,$C$2:$C$7))

F2 >>

=MAX(IF($A$2:$A$7=$A2,$C$2:$C$7))

 

[MickG]

NB:- This code will modify/Update your data and remove unwanted rows, see Code Notes.

[COLOR=navy]Sub[/COLOR] MG01Apr22
[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] q [COLOR=navy]As[/COLOR] Variant, K [COLOR=navy]As[/COLOR] Variant, nRng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Set[/COLOR] Rng = Range("B2", Range("B" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
[COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
     .Add Dn.Value, Array(Dn.Offset(, 1), Dn.Offset(, 2))
[COLOR=navy]Else[/COLOR]
    q = .Item(Dn.Value)
        [COLOR=navy]If[/COLOR] Dn.Offset(, 1) < q(0) [COLOR=navy]Then[/COLOR] q(0).Value = Dn.Offset(, 1)
        [COLOR=navy]If[/COLOR] Dn.Offset(, 2) > q(1) [COLOR=navy]Then[/COLOR] q(1).Value = Dn.Offset(, 2)
        [COLOR=navy]If[/COLOR] nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] [COLOR=navy]Set[/COLOR] nRng = Dn Else [COLOR=navy]Set[/COLOR] nRng = Union(nRng, Dn)
    .Item(Dn.Value) = q
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
'[COLOR=green][B]NB:- This line will remove all the other rows, except Max and Min date rows.[/B][/COLOR]
[COLOR=navy]If[/COLOR] Not nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] nRng.EntireRow.Delete
[COLOR=navy]End[/COLOR] With
Application.ScreenUpdating = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[TheOddGirl]

Hi Mick

This worked thanks very much for the code and effort - much appreciated

 

[MickG]

You're welcome