Sub EFG()
Dim oDict As Object
Set oDict = CreateObject("scripting.dictionary")
Dim rng As Range, cell As Range
Dim v As Variant, v1 As Variant
Dim i As Long, j As Long, temp As Variant
Dim msg As String
Set rng = Range(Cells(1, "M"), Cells(1, "M").End(xlDown))
On Error Resume Next
For Each cell In rng
If cell.Value > Date Then
If Not oDict.Exists(Format(cell.Value, _
"mm/dd/yyyy")) Then
oDict.Add Format(cell.Value, "mm/dd/yyyy"), _
cell.Value
End If
End If
Next
v = oDict.Keys
v1 = oDict.Items
For i = LBound(v1) To UBound(v1) - 1
For j = i + 1 To UBound(v1)
If v1(i) > v1(j) Then
temp = v1(i)
v1(i) = v1(j)
v1(j) = temp
End If
Next
Next
msg = ""
For i = LBound(v1) To LBound(v1) + 2
msg = msg & Format(v1(i), "mm/dd/yyyy") & " " & _
Application.CountIf(rng, v1(i)) & vbNewLine
Next
MsgBox msg
End Sub
--
Regards,
Tom Ogilvy
<john.9.williams@bt.com> wrote in message
news:1140713389.726566.140770@g44g2000cwa.googlegroups.com...
> I have a bit of a tricky one. I have a range of data that i am using
> to produce reports. One of these reports relates to column m. This
> range has various dates in each cell. These dates are in the past and
> future. What the reports needs to do is identify the first 3 dates in
> the range that are over todays date and report how many times these
> dates appear in the range, for instance
>
> the range may include
>
> feb 12
> feb 20
> mar 01
> mar 01
> april 01
> april 01
> april 10
> may 05
> may 05
>
> the results would be mar01 = 2 april 01 = 2 april 10 =1
>
> the reports ignores may 05 as its the fourth furthest date in the
> future
>
> hope someone can help as this has me stumpt
>
> regards
>
> John
>
Bookmarks