How to Test if a Date Falls within a Certain Range and Copy the Entire Row if So Using VBA - excel

Question

I have a file tjhat is serving as a log of product expirations. We track it by two dates, the date as provided by the manufacturer as well as the "Effective Expiration Date". The latter is the date in which the product would expire before someone could use it as directed.
Each year is a separate Worksheet (2022, 2023, 2024, etc.) with a table named after it (_2022, _2023, etc.).
We would like to create a Macro that will go through the the current year's table as well as the one for the next two years searching for a date that falls within the range of today's date through a week later. If it finds a match, the row should be copied over to a new sheet called "Weekly Exp" that is created by the Macro.
So if I ran it today, 12/17/2022, it will search for anything with an Effective Expiration Date between 12/17/2022 and 12/24/2022.
Here is what I have so far:
Sub weeklyExpirationSheet()
Dim dtToday As Date
Dim dtWeekOut As Date
Dim dtEffExp As Date
Dim dtTest As Date
Dim theYear As String
Dim countDays As Long
Dim ws As Worksheet
Dim srcSheet As Worksheet
Dim destSheet As Worksheet
Dim srcTable As ListObject
Dim srcRow As Range
dtToday = Date
dtWeekOut = DateAdd("ww", 1, dtToday)
countDays = DateDiff("d", dtToday, dtWeekOut)
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "Weekly Exp" Then
MsgBox "Weekly Audit Sheet Already Exists!"
Exit Sub
End If
Next ws
Sheets.Add(After:=Sheets("Incoming")).Name = "Weekly Exp"
Set destSheet = Worksheets("Weekly Exp")
With destSheet
Range("A1").Value = "UPC"
Range("B1").Value = "Brand"
Range("C1").Value = "Product"
Range("D1").Value = "Sz"
Range("E1").Value = "Expr"
Range("F1").Value = "Eff Exp"
Range("G1").Value = "Qty"
Range("H1").Value = "Location"
dtCurrentYear = CDbl(Year(Date))
dtEndYear = CDbl(dtCurrentYear + 2)
For y = dtCurrentYear To dtEndYear
Set srcSheet = Worksheets(CStr(y))
Set srcTable = srcSheet.ListObjects("_" & CStr(y))
With srcSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For p = 2 To LastRow
dtTest = .Cells(p, "F").Value
If dtTest >= dtToday And dtTest <= dtWeekOut Then
destLastRow = destSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(p).Copy Destination:=destSheet.Rows(destLastRow)
End If
Next p
End With
Next y
End With
End Sub
The code for getting the dates and such is working as is the detection/creation of the Worksheet. However when I run the Macro, it runs for a long period of time (like 3-5min) and then gives a Type Mismatch error. Nothing gets copied.
I did replace the copying code with MsgBox that would just display matches, it was going beyond the range. It reported an item that had a date of 12/31/2022 for example.
Edit:
This is what the data looks like

Answer 1

Your condition is missing the And operator so it always evaluates to True,
Write it like this:
If dtTest >= dtToday And dtTest <= dtWeekOut Then