Is date within a date range (VBA)

[wrightyrx7]

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.

 

[steve the fish]

Test this out:

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

 

[jmacleary]

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.

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

 

[wrightyrx7]

Test this out:

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.

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.

 

[jmacleary]

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.

 

[wrightyrx7]

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

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