Check if date falls between some range - vba

Question

I have data that is similar to:
A1: ID
B1: Start date
C1: End Date
I have another worksheet (call it New) that has
A1: ID and
B1: Date
I need to find out if the date for the ID in New worksheet was already in the previous Worksheet. If the date is start date, end date or anything in between, I want it to show that there is a record that already exist.

Answer 1

Solution here assuming something more practical:
A Master sheet with ID, Start Date, End Date (multiple rows)
Other sheets with ID and Date (multiple rows)
Uses a User Defined Function (UDF) and the ID cell as input
One drawback is that you will need "Calculate Sheet" if other sheets has been updated
Sample screenshots:
Formula for Sheet1 D2: =FindDuplicates(A2)
Code in a Module:
Option Explicit
Function FindDuplicates(oRngID As Range) As String
Dim sID As String, dStart As Date, dEnd As Date, lCount As Long, sWhere As String
Dim oWS As Worksheet, oRngFound As Range, dFound As Date, sFirstFound As String
sID = oRngID.Text
dStart = oRngID.Offset(0, 1).Value
dEnd = oRngID.Offset(0, 2).Value
lCount = 0
sWhere = ""
For Each oWS In ThisWorkbook.Worksheets
' Find all IDs in other worksheeets
If oWS.Name <> oRngID.Worksheet.Name Then
sFirstFound = ""
Set oRngFound = oWS.Cells.Find(What:=sID)
If Not oRngFound Is Nothing Then
sFirstFound = oRngFound.Address
' Keep searching until the first found address is met
Do
' Check the dates, only add if within the dates
dFound = oRngFound.Offset(0, 1).Value
If dStart <= dFound And dFound <= dEnd Then
lCount = lCount + 1
If lCount = 1 Then
sWhere = sWhere & lCount & ") '" & oWS.Name & "'!" & oRngFound.Address
Else
sWhere = sWhere & vbCrLf & lCount & ") '" & oWS.Name & "'!" & oRngFound.Address
End If
End If
Set oRngFound = oWS.Cells.Find(What:=sID, After:=oRngFound)
Loop Until oRngFound.Address = sFirstFound
End If
End If
Next
If lCount = 0 Then sWhere = "Not Found"
FindDuplicates = Replace(sWhere, "$", "") ' Removes the $ sign in Addresses
End Function

Answer 2

So, you have 3 problems:
1) Take value from another worksheet:
Dim startDate As Date
startDate = ActiveWorkbook.worksheets("OtherSheetName").cells(row,col).Value
2) Compare data:
If startDate <= actualDate And actualDate <= endDate Then
...
Else
...
End If
3) Set cell value:
ActiveWorkbook.worksheets("SheetName").cells(row,col).Value = something
Combine those steps and you'll obtain a solution for your problem.

Answer 3

I kinda liked this question...
The way I would do it would be using the SUMPRODUCT() function to check for multiple criteria (there are many references both on this site and Google explaining how that works)
In your New worksheet, assuming the first row is for headers, in cell C2 put in the following formula:
=SUMPRODUCT(--(Sheet1!$A$2:$A$180=A2),--((B2-Sheet1!$B$2:$B$180)>=0),--((Sheet1!$C$2:$C$180-B2)>=0)) > 0
And drag it down for your entire range (Obviously, adjusting the 180 row reference to suit your data-set)
Basically, what you're saying is:
Give me a TRUE only if there is at least one row in my other sheet where:
- The IDs match
- [My Date] minus row's [Start date] >= 0
- Row's [End Date] - [My Date] >= 0
Hope that makes sense!