displaying data from a range
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 I have this codes that works great and displays the dates in a message box, i would like to know how to adapt this to put the three dates and three totals into seperate cells 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 |
displaying data from a range
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 cells(i,"S").Value = v1(i) cells(i,"S").NumberFormat = "mmm dd" cells(i,"T").Formula = "=Countif(M:M,""=" & v1(i) _ & """)" Next End Sub -- Regards, Tom Ogilvy wrote in message oups.com... 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 I have this codes that works great and displays the dates in a message box, i would like to know how to adapt this to put the three dates and three totals into seperate cells 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 |
displaying data from a range
thanks again tom but its now only showing the first two dates, any
ideas John |
displaying data from a range
Here is a fix:
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 = "" j = 1 For i = LBound(v1) To LBound(v1) + 2 cells(j,"S").Value = v1(i) cells(j,"S").NumberFormat = "mmm dd" cells(j,"T").Formula = "=Countif(M:M,""=" & v1(i) _ & """)" j = j + 1 Next End Sub -- Regards, Tom Ogilvy wrote in message oups.com... thanks again tom but its now only showing the first two dates, any ideas John |
All times are GMT +1. The time now is 09:36 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com