Checking Date Conflicts VBA Excel-CodePudding

I need some help trying to figure out why this code is working the way it is. There are dates where it would say that there is a conflict when it shouldn't be. It would be great it I could have some help on this. I am relatively new to VBA and it is taking me a long time to think of a solution to this issue I am having.

The way the code should work is that if the date is in any of the two date ranges, then it would say "OK" OR if it says "Anytime" then it would also say "OK" because that would mean that the project can start at anytime. However, if the date is not within the range of any of the two date ranges given, then it would say "CONFLICT".

For example, if the date is within 8/1/2022 - 8/30/2022 or if it isnt in these dates, it would compare to the second date range 9/2/2022 - 9/20/2022 for example. The date has to fall into one of these in order to be "OK" if not then it is "CONFLICT"

Sub OutageWindow()
'
'This is testing the outage window conflict
'

Dim FoundCell As Range
Dim Subst As String
Dim StartD As String
Dim EndD As String
Dim i As Integer
Dim k As Long

Dim StartRef1 As String
Dim EndRef1 As String

Dim StartRef2 As String
Dim EndRef2 As String

'set a counter for k - which is loopng through each column
Dim LastRow  As Long

LastRow = Range("E" & Rows.Count).End(xlUp).Row

For k = 8 To LastRow

   
'get the cell value
Subst = Sheets("Master").Range("E" & k).Value

StartD = Sheets("Master").Range("K" & k).Value
EndD = Sheets("Master").Range("M" & k).Value

'Set the Range as Col B from the reference sheet and find the Str
Set FoundCell = Sheets("Sub_Ref_Matrix").Range("B:B").Find(What:=Subst)

'initialize Integer i as the row number to locate (more for debugging purpose to see if it is accurate)
i = FoundCell.Row


StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
EndRef1 = Sheets("Sub_Ref_Matrix").Range("D" & i).Value

StartRef2 = Sheets("Sub_Ref_Matrix").Range("E" & i).Value
EndRef2 = Sheets("Sub_Ref_Matrix").Range("F" & i).Value




'If the found cell is not empty, then print message in a column of Master sheet
If FoundCell.Row <> 100 Then
    
   If StartRef1 = "Anytime" And StartRef2 = "Anytime" Then
        Sheets("Master").Range("BB" & k).Value = "OK"
        Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
         
            
   
        'If the start date is within the reference dates then "OK"
       ElseIf (StartD >= StartRef1 And StartD <= EndRef1) And (EndD >= StartRef1 And EndD <= EndRef1) Then
            Sheets("Master").Range("BB" & k).Value = "OK"
            Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
          
               
                
                 'If the project lasts more than (15) 20 weeks AND if the Conflict was "OK" (Not including "Anytime" time frames), then highlight yellow and print "CHECK" instead
        If Sheets("Master").Range("BB" & k).Value = "OK" Then
             If DateDiff("ww", StartD, EndD) > 20 Then
                Sheets("Master").Range("BF" & k).Value = "The Project would last " & DateDiff("ww", StartD, EndD) & " week(s)"
                 Sheets("Master").Range("BB" & k).Value = "CHECK"
            End If
         End If
        
                
             ElseIf (StartD >= StartRef2 And StartD <= EndRef2) And (EndD >= StartRef2 And EndD <= EndRef2) Then
                Sheets("Master").Range("BB" & k).Value = "OK"
                Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
                    
                'If not, then provide info why
                ElseIf (StartD < StartRef1 Or StartD > EndRef1) And (EndD < StartRef1 Or EndD > EndRef1) Then
                Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                   Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
        
         ElseIf (StartD < StartRef2 Or StartD > EndRef2) And (EndD < StartRef2 Or EndD > EndRef2) Then
                Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                    Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
        End If

    'Provide location of col and row from reference sheet
        Sheets("Master").Range("BE" & k).Value = "The Subst " & Subst & " at B" & i
        Sheets("Master").Range("I" & k).Value = Round(DateDiff("D", StartD, EndD) / 7, 1) & " wks"
        
    End If
'increment k to go through the entire column
Next k
                       
                                     
End Sub

**EDIT: Here is an update on my code which gave the same output:

Sub OutageWindow()
'
'This is testing the outage window conflict
'

Dim FoundCell As Range
Dim Subst As String
Dim StartD As Variant
Dim EndD As Variant
Dim i As Integer
Dim k As Long



'set a counter for k - which is loopng through each column
Dim LastRow  As Long

LastRow = Range("E" & Rows.Count).End(xlUp).Row

For k = 8 To LastRow

   
'get the cell value
Subst = Sheets("Master").Range("E" & k).Value

StartD = Sheets("Master").Range("K" & k).Value
EndD = Sheets("Master").Range("M" & k).Value

'Set the Range as Col B from the reference sheet and find the Str
Set FoundCell = Sheets("Sub_Ref_Matrix").Range("B:B").Find(What:=Subst)

'initialize Integer i as the row number to locate (more for debugging purpose to see if it is accurate)
i = FoundCell.Row

Dim StartRef1 As Variant: StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
Dim EndRef1 As Variant: EndRef1 = Sheets("Sub_Ref_Matrix").Range("D" & i).Value

Dim StartRef2 As Variant: StartRef2 = Sheets("Sub_Ref_Matrix").Range("E" & i).Value
Dim EndRef2 As Variant: EndRef2 = Sheets("Sub_Ref_Matrix").Range("F" & i).Value


'If the found cell is not empty, then print message in a column of Master sheet
If FoundCell.Row <> 100 Then
    
Select Case True
    Case IsDate(StartRef1)
        Select Case True
            Case (StartD >= StartRef1 And StartD <= EndRef1) And (EndD >= StartRef1 And EndD <= EndRef1)
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2

                
                Case Else
                   Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                   Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
           End Select
                
    
    Case IsDate(StartRef2)
        Select Case True
              Case (StartD >= StartRef2 And StartD <= EndRef2) And (EndD >= StartRef2 And EndD <= EndRef2)
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2

                Case Else
                   Sheets("Master").Range("BB" & k).Value = "CONFLICT"
                   Sheets("Master").Range("BC" & k).Value = StartD & " to " & EndD & " Not in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
    End Select
    
    
    Case Not IsNumeric(StartRef1)
        Select Case StartRef1
            Case "Anytime"
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
            'Case "N/A"
    
        End Select
        
         Case Not IsNumeric(StartRef2)
        Select Case StartRef2
            Case "Anytime"
                 Sheets("Master").Range("BB" & k).Value = "OK"
                 Sheets("Master").Range("BC" & k).Value = StartD & " and " & EndD & " in Range of " & StartRef1 & " and " & EndRef1 & " or " & StartRef2 & " and " & EndRef2
            'Case "N/A"
    
        End Select
        End Select
   End If
'increment k to go through the entire column
Next k
     
End Sub

CodePudding user response：

Quick example of determining what is the format for data in StartRef1 using Select (untested):

Dim StartRef1 as Variant:  StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
Select Case True
    Case IsDate(StartRef1)
        Select Case True
            Case StartD >= StartRef1 And EndD <= EndRef1
                'Do one
            Case Else
                'Do two
        End Select
    Case Not IsNumeric(StartRef1)
        Select Case StartRef1.Value
            Case "Anytime"
                'Do something
            Case "N/A"
                'Do something else
            Case Else
                MsgBox "This is not a date, nor does it contain *Anytime* or *N/A*"
        End Select
End Select

Currently, you have Dim StartRef1 as String: StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value which may lead to the inability to compare to numbers/dates, e.g., you fail to determine if StartD >= StartRef1.

If you ensure you have a date (IsDate()), then you can be able to compare... similarly, you need to ensure that StartD and the other variables are of the same type.

Edit1:

Quick update to show comparison of month/day only, after IsDate(), using a fixed year to not take year into account:

Dim StartRef1 as Variant:  StartRef1 = Sheets("Sub_Ref_Matrix").Range("C" & i).Value
Select Case True
    Case IsDate(StartRef1)
        Select Case True
            Case DateSerial(1900,Month(StartD),Day(StartD)) >= DateSerial(1900,Month(StartRef1),Day(StartRef1)) And DateSerial(1900,Month(EndD),Day(EndD)) >= DateSerial(1900,Month(EndRef1),Day(EndRef1)) And StartD <= EndD
                'Do one
            Case Else
                'Do two
        End Select
    Case Not IsNumeric(StartRef1)
        Select Case StartRef1.Value
            Case "Anytime"
                'Do something
            Case "N/A"
                'Do something else
            Case Else
                MsgBox "This is not a date, nor does it contain *Anytime* or *N/A*"
        End Select
End Select