Is date within a date range (VBA)

wrightyrx7

Well-known Member
Joined
Sep 15, 2011
Messages
994
Im trying to think of the best way to check if a date range contains 01 November.

If it was a static date i would just use <= AND >= on the start and end date.

However, this is just 01 November with NO set year. If the 01 November is within the Start and End date (including the start and end date themselves) then im going to try and split the row so one runs until 31/10 then the new one starts 01/11. So if the date rage DOES contain 01/ November it would be good if i could find out which YEAR it is.
 
Last edited:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Test this out:

Code:
Dim datestart As Date, dateend As Date, mydate As Date

datestart = DateSerial(2019, 11, 2)
dateend = DateSerial(2020, 11, 1)
mydate = DateSerial(Year(datestart), 11, 1)

If datestart > mydate Then mydate = WorksheetFunction.EDate(mydate, 12)

If dateend >= mydate Then
    MsgBox "Contains 1 nov"
Else
    MsgBox "Doesnt contain 1 nov"
End If
 
Upvote 0
You can use the day and month functions in VBA. The code below runs for the range specified. Replace Range("B12:B18") with your desired range, and the msgbox line with whatever you had in mind for the splitting.
Code:
Sub dater()
For Each c In ActiveSheet.Range("B12:B18").Cells
If Day(c.Value) = 1 And Month(c.Value) = 11 Then
 MsgBox "found one"
End If
Next

End Sub
 
Last edited:
Upvote 0
Test this out:

Code:
Dim datestart As Date, dateend As Date, mydate As Date

datestart = DateSerial(2019, 11, 2)
dateend = DateSerial(2020, 11, 1)
mydate = DateSerial(Year(datestart), 11, 1)

If datestart > mydate Then mydate = WorksheetFunction.EDate(mydate, 12)

If dateend >= mydate Then
    MsgBox "Contains 1 nov"
Else
    MsgBox "Doesnt contain 1 nov"
End If

Thank you, this kind of works but my start and end date couple span multiple 01 Novembers. However, this has given me an idea of how a might be able to do it.

You can use the day and month functions in VBA. The code below runs for the range specified. Replace Range("B12:B18") with your desired range, and the msgbox line with whatever you had in mind for the splitting.
Code:
Sub dater()
For Each c In ActiveSheet.Range("B12:B18").Cells
If Day(c.Value) = 1 And Month(c.Value) = 11 Then
 MsgBox "found one"
End If
Next

End Sub

When I said a date range I meant the dates between 2 dates. Not the dates in a range of cells. Im sorry for not being clearer. But this could work by checking each date between the 2 dates but might take a while to run for the amount of data I have.
 
Upvote 0
might take a while to run for the amount of data I have.
Hi there. I have just run this for 22000 rows x 240 columns and it took less than 15 seconds, finding 13300 november the firsts in the process, so it shouldnt be too bad timewise.
 
Upvote 0
Hi there. I have just run this for 22000 rows x 240 columns and it took less than 15 seconds, finding 13300 november the firsts in the process, so it shouldnt be too bad timewise.

Thank you, but i also needed to split the rows when i found one haha

I ended up altering steve the fish's code, just so it looped though the number of years between the start and end date

Code:
Sub Test()
Dim lRow As Long, i As Long, x As Long, y As Long
Dim sDate As Date, eDate As Date, myDate As Date


Application.ScreenUpdating = False


    With ActiveSheet
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'Loop through rows
        For i = lRow To 2 Step -1
            
            sDate = .Cells(i, 10).Value
            eDate = .Cells(i, 11).Value
            
            x = Year(eDate) - Year(sDate)
            'Loop through years
            For y = 0 To x
                myDate = DateSerial(Year(sDate) + y, 11, 1)


                If sDate < myDate And eDate >= myDate Then
                    Rows(i).EntireRow.Copy                    
                    Rows(i).Insert Shift:=xlDown
                    Application.CutCopyMode = False
                    i = i + 1
                    .Cells(i, 11).Value = myDate - 1
                    .Cells(i - 1, 10).Value = myDate

                End If
            Next y
        Next i
    End With
    
MsgBox "Complete!"
Application.ScreenUpdating = True


End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

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