CODEWITHSUNDEEP
excelvba
Samboff
Samboff

Reputation: 43

Find the earliest and latest dates and create timeline with months

I have a column of unknown length (column Q) and I want to find the earliest and latest dates in this column. The first entry is in cell "Q2". The Dates are not arrange chronologically, so I can't simply look at the first and last row. Furthermore, I would like to paste all the months between the two dates in a new Worksheet. I have tried to find the earliest and latest dates, but I am already strugling with the code. Here is an extract of my code:

Dim SDate As Date, LDate As Date
Dim last_row As Long
Dim LastCell As String

last_row = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

LastCell = "Q" & last_row

Worksheets("Sheet1").Select
SDate = WorksheetFunction.Min(Range("Q2:LastCell"))
EDate = WorksheetFunction.Max(Range("Q2:LastCell"))

It tells me that it does not recognize the value LastCell as an input for Range. [The date format in Sheet1 is dd.mm.yyyy]

As Output in Sheet2, I would like for it to look something like this (Starting in Cell D2): Wanted Output

Can anyone help me out? I am pretty new to VBA

Thank you in advance Sam

Upvotes: 1

Views: 185

Answers (2)

FaneDuru
FaneDuru

Reputation: 42256

Please, try the next code. It does not use any iteration:

Sub testDateRange()
   Dim sh As Worksheet, sh2 As Worksheet, lastR As Long, rng As Range, minDate As Date, maxDate As Date, arrD
   
   Set sh = ActiveSheet         'use here your necessary sheet
   Set sh2 = ActiveSheet.Next   'use here your necessary sheet (Sheet2)
   lastR = sh.Range("Q" & sh.rows.count).End(xlUp).row
   Set rng = sh.Range("Q1:Q" & lastR)
   minDate = WorksheetFunction.min(rng)
   maxDate = WorksheetFunction.Max(rng)

   If minDate = DateValue("00:00:00") Or maxDate = DateValue("00:00:00") Then
        MsgBox "One of the two necessary date could not be found...": Exit Sub
   End If

   arrD = GetMonthsInt(minDate, maxDate)    'get an array of the necessary months interval
   'Drop the array contents in the sheet:
   With sh2.Range("D1").Resize(1, UBound(arrD))
        .value = Application.Transpose(arrD)
        .NumberFormat = "MMM YY"
        .EntireColumn.AutoFit
    End With
End Sub

Private Function GetMonthsInt(startDate As Date, endDate As Date) As Variant
   Dim monthsNo As Long, rows As String, monthsInt
    monthsNo = DateDiff("m", startDate, endDate, vbMonday)
    rows = Month(startDate) & ":" & monthsNo + Month(startDate)

    If Day(startDate) > 28 Then dd = 28 Else: dd = Day(startDate)
    monthsInt = Evaluate("Text(Date(" & Year(startDate) & ",row(" & rows & "),1),""mmmm YYYY"")")
    GetMonthsInt = monthsInt
End Function

Upvotes: 1

Samuel Everson
Samuel Everson

Reputation: 2102

I found this a bit difficult due to Excel auto formatting my outputs as "yyyy/mm/d" however overcame this issue by using the Range.Value2 property rather than Value.

Relevant documentation:

Sub ShowMonthsBetweenTwoDates()
    Dim DatesArray As Variant
    Dim StartDate As Date: StartDate = Range("C1")
    Dim EndDate As Date: EndDate = Range("C2")
    Dim Iteration As Long
    Dim Years As Long
    Dim Months As Long
    Dim TotalMonths As Long
    
    Months = (Month(EndDate) - Month(StartDate))
    Years = (Year(EndDate) - Year(StartDate)) * 12
    TotalMonths = (Months + Years)
    
    ReDim DatesArray(TotalMonths)
    For Iteration = LBound(DatesArray) To UBound(DatesArray)
        If WorksheetFunction.EDate(StartDate, Iteration) <= EndDate Then
            DatesArray(Iteration) = WorksheetFunction.EDate(StartDate, Iteration)
        End If
    Next Iteration
    Iteration = 0
    
    Dim DestinationRange As Range
    Set DestinationRange = Range("E1").Resize(1, TotalMonths + 1)
    DestinationRange.NumberFormat = "mmm-yy"
    
    DestinationRange.Value2 = DatesArray
End Sub

This sub:

  • Uses dates as start and end from Cells C1 and C2, which use the MIN and MAX functions to find the lowest and highest date in a range (See sample screenshot below)
  • Counts the months between the two dates. This is done in 2 steps, months and years to account for multiple years in your date span.
  • Loops through using EDate to check if the date is <= the end date and if so it adds the date to the array.
  • Defines a destination range (I used Cell E1 as the starting point) and then writes the Array values to this range.

Sample Worksheet data tested on:

Sample worksheet date range and data

And the output:

Sample output

Note:

You may need to do some testing and modify the calculations/if statement evaluation as I haven't tested for all possible date scenarios - with the calculations I've used there may be some discrepancies (such as if the end date is 1 day less then the day of the date being checked) but again - this has not been tested for.

This solution allows you to get a start and end date and output your desired format to a range.

Note Note:

Using Value2 may provide unexpected results if using the output data in any calculations/evaluations - if you must use the Value property instead and look up one of the many existing solutions for getting around the obnoxious auto formatting of dates by excel.

Upvotes: 1

Related Questions