Finding all the dates and copy them in separate place

[Amit Shukla]

I have a table in my excel where all the project task completion dates are put.
I need to find all the dates that are in the current month, next month and so on.
Need to filter are the dates in ascending order so that it is easy for a follow-up.
There can be a duplicate entry also as a single date can have two different project tasks completing.
Besides every date, in the adjacent column, it should also mention the project head (in this case is the location).

 

[Amit Shukla]

Thanks, Yongle
Everything works perfectly except one
The result is adding up after the previous one. There is some issue with the clear content part.
One only change I made was introducing a new sheet named Summary and the result is directed to B column last available cell.

 

[Yongle]

Is sheet Summary the original sheet which contains all the dates or a different sheet ?

If it is a different sheet what else is in column B ?

 

[Amit Shukla]

The Summary is a different worksheet and it contains no data other than the result. But have input conditional formating to find duplicated dates.

If can generate a new sheet every time then the name should be "Summary" and the result should be Date, Count (Number of same dates) and Locations concatenated.

 

[Yongle]

Will post amended code within next 24 hours

 

[Amit Shukla]

Hi Yongle, Waiting for your revert...

 

[Yongle]

Code assumes sheet "Summary" already exists

Amend B2 to the cell which will contain the first date value in Sheet "Summary"
Set Result = Sheets("Summary").Range("B2")

Sub GetDates()
    Dim Region As Range, Cel As Range, CelAbove As Range, Result As Range
    Dim ws As Worksheet, Data As Worksheet, r As Long, FromDate As Date, ToDate As Date
    Set Data = Sheets("Sheet1")                                         'which sheet contains the dates ???
    Set Result = Sheets("Summary").Range("B2")                          'results go here
    Data.Activate
    On Error Resume Next
'get dates
    FromDate = DateSerial(Year(Date), Month(Date), 1)
    FromDate = InputBox("OK to contine or amend date", "FIRST DAY OF MONTH", Format(FromDate, "dd-mmm-yy"))
    ToDate = DateSerial(Year(FromDate) + 1, Month(FromDate), 1)
    Application.ScreenUpdating = False
    Set ws = Sheets.Add
'add dates
    For Each Region In Data.Range("A2", Data.Cells(2, Columns.Count).End(xlToLeft))
        If Region <> "" Then
            For Each Cel In Region.CurrentRegion
                If Cel > FromDate And Cel < ToDate Then ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 2).Value = Array(Cel, Region)
            Next Cel
        End If
    Next Region
'sort dates
    With ws.Range("A1").CurrentRegion
        .Sort [A1], xlAscending
        .Resize(, 1).NumberFormat = "dd-mmm-yy"
        .RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    End With
'insert space
    For r = ws.Cells(Rows.Count, 1).End(xlUp) To 2 Step -1
        Set Cel = ws.Cells(r, 1)
        Set CelAbove = Cel.Offset(-1)
        If Month(Cel) <> Month(CelAbove) Then Cel.Resize(, 2).Insert Shift:=xlDown
    Next r
'clear previous result and replace with latest result
    Result.Resize(Rows.Count - Result.Row, 2).ClearContents
    ws.UsedRange.Copy: Result.PasteSpecial (xlPasteValuesAndNumberFormats)
    Application.DisplayAlerts = False: ws.Delete: Application.DisplayAlerts = True
End Sub