identify earliest & latest date groups in table

Try this:-
Results start sheet (2) "A1".

Sub MG17Jul25
Dim Rng     As Range
Dim Dn      As Range
Dim Q       As Variant
Dim Twn     As String

Set Rng = Range(Range("L2"), Range("L" & Rows.Count).End(xlUp))
    With CreateObject("scripting.dictionary")
       .CompareMode = vbTextCompare
For Each Dn In Rng
    Twn = Dn & Dn.Offset(, 1)
        If Not .Exists(Twn) Then
            .Add Twn, Array(Dn, Dn(, 2), Dn(, 3), Dn(, 4))
        Else
            Q = .Item(Twn)
            If Dn(, 3) < (Q(2)) Then Q(2) = Dn(, 3)
            If Dn(, 4) > (Q(3)) Then Q(3) = Dn(, 4)
            .Item(Twn) = Q
        End If

Next
 Sheets("sheet2").Range("A1").Resize(.Count, 4) = Application.Index(.items, Evaluate("row(" & 1 & ":" & .Count & " )"), Array(1, 2, 3, 4))
End With
End Sub

Regards Mick

Hi Mick,

Thanks for offering a solution to this.

The code almost works but for some reason the dates are in different formats and or transposed and don't seem to want to re-format.

Eg 01/08/11 is being returned as 08/01/11 and some dates are shown as dd/mm/yy and others dd/mm/yyyy.

Please would you take another look at it?

Thanks,

Louise

Try this:-
If this does not work try formatting the columns where the dates will be returned.

Sub MG17Jul11
Dim Rng     As Range
Dim Dn      As Range
Dim Q       As Variant
Dim Twn     As String
Dim Dt1 As Date
Dim Dt2 As Date
Set Rng = Range(Range("L2"), Range("L" & Rows.Count).End(xlUp))
    With CreateObject("scripting.dictionary")
       .CompareMode = vbTextCompare
For Each Dn In Rng
    Twn = Dn & Dn.Offset(, 1)
        Dt1 = Format(Dn(, 3), "dd/mm/yyyy")
        Dt2 = Format(Dn(, 4), "dd/mm/yyyy")
        If Not .Exists(Twn) Then
            .Add Twn, Array(Dn, Dn(, 2), Dt1, Dt2)
        Else
            Q = .Item(Twn)
            If Dt1 < DateValue(Q(2)) Then Q(2) = Dt1
            If Dt1 > DateValue(Q(3)) Then Q(3) = Dt2
            .Item(Twn) = Q
        End If

Next
 Sheets("sheet2").Range("A1").Resize(.Count, 4) = Application.Index(.items, Evaluate("row(" & 1 & ":" & .Count & " )"), Array(1, 2, 3, 4))
End With
End Sub

Regards Mick

Hi again Mick,

This time I get a run time error 13 - type mismatch error.

I've tried formatting the columns but makes no difference.

It must be almost there, please would you suggest a fix?

Thanks

Louise

Have you got any cells in those 4 columns that are blank or cells that should be a date, and are not.

The destination worksheet and cells are blank.

Thanks

Louise

Sorry, what I meant was, are any of the Data cells That should have Text Numbers or Dates Blank or any of the Data cells that should contain Dates, Blank.
Example :- Your data is in Columns "L to O", if say there are 100 rows in those columns with data if any cell within this range is blank or has not got a date, you could get that error.
If there are blanks and that is how your data would normally be presented to you, then I can perhaps alter the code to take account of that, but I was trying to understand where the error came from.
Mick