Hi
Can you please try this ? Enter the search date in N3 on summary sheet (if the cell is different, refer the cell in the code)
Code:Option Explicit Sub Summaryv2() Dim wksEach As Worksheet Dim wksSummary As Worksheet Dim dtDate As Date Dim LastRow As Long Dim lngLoop As Long Dim dic As Object Dim strKey As String Dim Data Const OutputDateFormat As Long = 4 'd-m-y (Repladce 4 with 3 if you want m-d-y format) Set dic = CreateObject("scripting.dictionary") Set wksSummary = ThisWorkbook.Worksheets("Summary") '//cell where you will enter the search date dtDate = wksSummary.Range("n3").Value '<<<< adjust this range For Each wksEach In ThisWorkbook.Worksheets If Not wksEach.Name = wksSummary.Name Then With wksEach LastRow = .Range("l" & .Rows.Count).End(xlUp).Row Data = .Range("l6:m" & LastRow).Value2 For lngLoop = 1 To UBound(Data, 1) If Len(Data(lngLoop, 1)) * Len(Data(lngLoop, 2)) Then On Error GoTo Nxt If CDate(Data(lngLoop, 1)) <= dtDate Then dic.Item(.Name) = CDate(Data(lngLoop, 1)) & "|" & Data(lngLoop, 2) Else Exit For End If End If Nxt: Err.Clear: On Error GoTo 0 Next Erase Data End With End If Next If dic.Count Then With wksSummary LastRow = .Range("a" & .Rows.Count).End(xlUp).Row With .Range("a" & LastRow + 1) .Resize(dic.Count).Value = Application.Transpose(dic.keys) .Offset(, 1).Resize(dic.Count).Value = Application.Transpose(dic.items) .Offset(, 1).Resize(dic.Count).TextToColumns Destination:=.Offset(, 1), Other:=True, OtherChar _ :="|", FieldInfo:=Array(Array(1, OutputDateFormat), Array(2, 1)) .Offset(, 1).Resize(dic.Count).NumberFormat = "dd-mmm-yyyy" End With End With MsgBox "Complete" End If End Sub




Reply With Quote
Bookmarks