Date Range

  • Hi All,


    Is there any method in VBA such that when a start data and end date is keyed in by the user, the code itself can find capture and output the dates in between the 2 user entered dates.


    For example,
    input=> [COLOR="Magenta"]start_date = 1st Jan 07[/COLOR]
    input=> [COLOR="magenta"]end_date = 5th Jan 07[/COLOR]
    ouput=> [COLOR="SeaGreen"]date_in_between_inclusive is 1st Jan 07, 2nd Jan 07, 3rd Jan 07, 4th Jan 07, 5th Jan 07[/COLOR]


    Can anybody help me ?

  • Re: Date Range


    How do you want to input the dates and where do you want the dates listed?


    Try This (input start date into A1, end date into A2):


  • Re: Date Range


    Hi Reafidy,


    I would want to enter the date in numbers form and output as number form.


    For example,
    [COLOR="Magenta"]Input: 010107 for 1st Jan 07 (start date)[/COLOR]
    [COLOR="Magenta"]Input: 050107 for 5th Jan 07 (end date)[/COLOR]
    [COLOR="DarkOrchid"]Output : 070101, 070102, 070103, 070104, 070105 which is in the form of year-mth-day[/COLOR]

  • Re: Date Range


    Sorry, what I meant was are you just entering the dates into certain cells (if so which ones) or are you entering the dates into a userform or something.


    And where do you want the output dates to be listed, for example cell A2 and below?

  • Re: Date Range


    Hi Readify,


    I intend to use the inputbox to capture user input and assign the output to an array because i need the date in numbers for other purpose. Can you help ?



  • Re: Date Range


    I'd recommend having a standard date input, then you can format the output however you'd like:

    Code
    Format(date_in_between_inclusive, "YYMMDD") = end_date - start_date
  • Re: Date Range


    Try,


    [vba]Sub test()
    Dim sDate As String, eDate As String, a(), x
    Dim sDt As Date, eDt As Date, i As Long, k As Long


    sDate = InputBox("Enter Start Date", "Start Date", "yyyy,m,d")
    eDate = InputBox("Enter End Date", "End Date", "yyyy,m,d")
    x = Split(sDate, ",")
    On Error GoTo ErrHandlr
    sDt = DateSerial(x(0), x(1), x(2))
    x = Split(eDate, ",")
    eDt = DateSerial(x(0), x(1), x(2))
    If eDt < sDt Then
    MsgBox "End Date Must be Greater than Start Date"
    Exit Sub
    End If
    k = (eDt - sDt) + 1
    ReDim a(1 To k)
    For i = 1 To k
    a(i) = (sDt - 1) + i
    Next
    ReDim Preserve a(1 To (i - 1))
    For i = LBound(a) To UBound(a)
    MsgBox a(i)
    Next
    Exit Sub
    ErrHandlr:
    MsgBox "Invalid Date Entry"
    End Sub[/vba]


    HTH

  • Re: Date Range


    Hi,


    Try,


    [vba]Sub test()
    Dim sDate As String, eDate As String, a(), x
    Dim sDt As Date, eDt As Date, i As Long, k As Long
    Dim Yr As Integer, Mth As Byte, Dy As Byte

    sDate = InputBox("Enter Start Date", "Start Date", "yy,mm,dd")
    eDate = InputBox("Enter End Date", "End Date", "yy,mm,dd")
    x = Split(sDate, ",")
    Yr = IIf(Val(x(0)) <= 7, 2000 + Val(x(0)), 1900 + Val(x(0)))
    Mth = Val(x(1)): Dy = Val(x(2))
    On Error GoTo ErrHandlr
    sDt = DateSerial(Yr, Mth, Dy)
    x = Split(eDate, ",")
    Yr = IIf(Val(x(0)) <= 7, 2000 + Val(x(0)), 1900 + Val(x(0)))
    Mth = Val(x(1)): Dy = Val(x(2))
    eDt = DateSerial(Yr, Mth, Dy)
    If eDt < sDt Then
    MsgBox "End Date Must be Greater than Start Date"
    Exit Sub
    End If
    k = (eDt - sDt) + 1
    ReDim a(1 To k)
    For i = 1 To k
    a(i) = (sDt - 1) + i
    Next
    ReDim Preserve a(1 To (i - 1))
    For i = LBound(a) To UBound(a)
    MsgBox a(i)
    Next
    Exit Sub
    ErrHandlr:
    MsgBox "Invalid Date Entry"
    End Sub[/vba]


    HTH

  • Re: Date Range


    Hi Kris,


    I have made some modification and added in the below but i didn;t seem to get the output that i need.
    If i key in start date as 07,01,01 and end date as 07,01,05, i would expect 070101,070102,070103,070104,070105 as my desired output. Can you help ?



  • Re: Date Range


    Hi,


    [vba]Sub test()
    Dim sDate As String, eDate As String, a(), b(), x, y
    Dim sDt As Date, eDt As Date, i As Long, k As Long
    Dim Yr As Integer, Mth As Byte, Dy As Byte

    sDate = InputBox("Enter Start Date", "Start Date", "yy,mm,dd")
    eDate = InputBox("Enter End Date", "End Date", "yy,mm,dd")
    x = Split(sDate, ",")
    Yr = IIf(Val(x(0)) <= 7, 2000 + Val(x(0)), 1900 + Val(x(0)))
    Mth = Val(x(1)) 'Val method is to indicate the number in integer form instead of date form
    Dy = Val(x(2))
    On Error GoTo ErrHandlr
    sDt = DateSerial(Yr, Mth, Dy)
    x = Split(eDate, ",")
    Yr = IIf(Val(x(0)) <= 7, 2000 + Val(x(0)), 1900 + Val(x(0)))
    Mth = Val(x(1)): Dy = Val(x(2))
    eDt = DateSerial(Yr, Mth, Dy)
    If eDt < sDt Then
    MsgBox "End Date Must be Greater than Start Date"
    Exit Sub
    End If
    k = (eDt - sDt) + 1 'Find the number of days between the start date and end date
    MsgBox k
    ReDim a(1 To k)
    For i = 1 To k
    a(i) = (sDt - 1) + i 'Add every date in between and assign to an array
    Next

    ReDim Preserve a(1 To (i - 1))
    For i = LBound(a) To UBound(a)
    'y = y & vbCrLf & Format(a(i), "yy,mm,dd")
    y = y & Format(a(i), "yymmdd") & ","
    Next
    MsgBox Left(y, Len(y) - 1)
    Exit Sub
    ErrHandlr:
    MsgBox "Invalid Date Entry"
    End Sub[/vba]


    HTH

  • Re: Date Range


    This answer is close to what I need, but mine is a little more complicated. I need my dates to be listed up to 7 days per sheet. Let me explain. I have a worksheet that has 5 tabs/sheets. Each sheet has 7 days of entries. The first sheet has a start date and an end date. I would like to then take those dates and have them automatically fill in the date range 7 days per sheet up to 5 sheets with 5 rows in between each date cell on each page.


    Do you have any suggestions?



    Thanks

  • Re: Date Range


    Welcome to the forum, JBiggs.


    This thread is over 5 years old and forum policy is that you always start a new thread for your issue, not post in threads started by other members.


    Please remember to follow the rules as regards thread titles and, if you are posting code, to wrap the code with code tags. You can read more about the rules if you click the 'I agreed to these rules' link under your name in your post above.


    If you think this thread can help clarify your issue, you can include a link by copying the URL from the address bar of your browser and pasting into your message...

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!