VBA code to list the individual dates between two dates

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
2,169
Office Version
  1. 2016
Platform
  1. Windows
In the post at:
I was looking for a way around getting advanced Filter to work for dates stored as texts in the format "dd-mm-yy".
According to @Marc L, it is not a good idea to store dates as texts. But looking at the situation I was facing, to me, it was the way to go. So I kept trying until I was able to get it working by using some for loops to compare the text dates with my input then once it matches, I copy the range i want - which is working cool atm.

My challenge now is that in case I want to get data that falls between two dates, I don't know how to do that.
I think if I am able to:
1. List all the dates between two dates - my input is like this:
>>> date1, date2 in the format dd-mm-yy. <<<
ie vDate is the variable that takes the dates .
2. I can then run my date against those on the sheet (text dates) to see if they match any of the dates I have generated from the two user input dates.

**** The first date will always be smaller than the second

Can someone please help me with this challenge?

Thanks in advance.
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
when you write your textbox to your sheet, transform it to a real date instead of a string and eventually make it a double-variable (that last is perhaps not necessary).
VBA uses the american "mm-dd" way (month first), so 12 jan becomes 1 dec.
13 jan remains unchanged, as there are only 12 months in a year, VBA doesn't try to be smarter.
Then all your others problems 'll be solved, i assume.
VBA Code:
    sp = Split(Textbox1.Value, "-")                            ' textbox1 is like "dd-mm-yy", so split it into 3 parts
     Range("A1").Value = CDbl(DateSerial(sp(2), sp(1), sp(0)))  'make a date of it, and perhaps for safety a double-value
 
Upvote 0
Solution
Hi @BSALV
Your option worked fine. I also tested it with the CDate and DateValue functions and they seem to be back online. The reason I can't tell for now.

Before then, I was working on my text date challenge and this is what I produced:


Code:
Option Explicit
Sub TestDates()
    Dim dfDate&
    Dim i&, dNew$, dLast$, d$, m$, y$, mNext&, fEnd As Boolean
    Dim uInput, sp, esp, dSt&, dEn&, dlEnd$, mLast&, dRng As Range
    
    uInput = "01-01-21,01-01-22"
    sp = Split(uInput, ",")
    
    dfDate = DateDiff("d", DateValue(sp(0)), DateValue(sp(1))) + 1
    
    If dfDate > 366 Then
        MsgBox "We cant handle " & dfDate & " days!!!", vbExclamation
        Exit Sub
    End If
    
    esp = Split(sp(0), "-")
    m = esp(1)
    y = esp(2)
    dLast = sp(1)
    dlEnd = ""
    dEn = 31
    dSt = Val(esp(0))
    
    Range("A1:A1000").ClearContents
    
    Select Case Val(esp(1))
        Case 2
            dEn = 28
            If esp(2) Mod 4 = 0 Then dEn = 29
        Case 4, 6, 9, 11
            dEn = 30
    End Select
    
    Application.ScreenUpdating = False
    
    While dLast <> dlEnd
        fEnd = False
        For i = dSt To dEn
            Set dRng = Cells(Rows.Count, "A").End(xlUp).Offset(1)
            d = Format(i, "00")
            dNew = d & "-" & m & "-" & y
            dRng = dNew
            If i = dEn Then
                mLast = Val(m)
                If dNew = dLast Then
                    dlEnd = dNew
                    fEnd = True
                End If
            End If
            If dNew = dLast Then
                dlEnd = dNew
                fEnd = True
                Exit For
            End If
        Next i
        
        If Not fEnd Then
            dSt = 1
            dEn = 31
            y = esp(2)
            mNext = mLast + 1
            
            If mLast = 12 Then
                If Right(sp(0), 2) <> Right(sp(1), 2) Then
                    y = Right(sp(1), 2)
                    mNext = 1
                End If
            End If
            
            m = Format(mNext, "00")
            
            Select Case mNext
                Case 2
                    dEn = 28
                    If y Mod 4 = 0 Then dEn = 29
                Case 4, 6, 9, 11
                    dEn = 30
            End Select
        End If
    Wend
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
make column A widther and day 1-12 of every month is right aligned as they are numbers for excel and the others left aligned, thus strings. Those first 12 days are reversed day-month !
VBA Code:
Sub testdates2()
     Dim Startdate As Date, MyDates

     Startdate = DateSerial(2021, 1, 1)                         'your 1st day
     ThisWorkbook.Names.Add "MyDay1", Startdate                 'put it in a defined name
     MyDates = [transpose(row(1:3660)-1+myday1)]                'serie of the next 10 years
     Range("B2").Resize(365) = Application.Transpose(MyDates)   'copy the first 365 to your sheet
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top