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.