title: Highlight Overlap Days Excel VBA
body: <p>I have the following problem to solve to increase the speed at which the code performs the task. </p>
  
  <p>I have a table with names of Hire Cars and two dates - From and To. I need to go through the range (say 10k rows) check and highlight all overlapping dates.</p>
  
  <p>No   Hire Car    From        To  </p>
  
  <p>1    ABC         01 Jan 12   12 Jan 12<br>
  2    ABC         14 Jan 12   15 Jan 12<br>
  3    ABC         25 Jan 12   02 Feb 12<br>
  4    DEF         01 Jan 12   12 Jan 12<br>
  5    DEF         12 Jan 12   02 Feb 12<br>
  6    DEF         14 Jan 12   15 Jan 12  </p>
  
  <p>For hire car DEF there are overlapping days, double counting in fact which i need to be able to highlight so that the user can quickly identify and correct.</p>
  
  <p>This is the code that I have developed. The problem is that if you have a Range of 10k Rows it is extremely slow.</p>
  
  <p>I am using Windows 7 Ultimate with Office/Excel 2010</p>
  
  <pre><code>    Function CheckOverlap(StartLine, EndLine, StartColumn)
  
  Dim i As Integer, y As Integer
  Dim DateToCompare
  Dim HireCar
  Dim Count As Integer
  Dim Msg, Style, Title, Response
  
  'Check StartDate Column
  For i = StartLine To EndLine
  
      DateToCompare = Cells(i, StartColumn)
      HireCar = Cells(i, 2)
      For y = StartLine To EndLine
          'If we are at the same line with DateToCompare cell then we should not perform any check
          If i &lt;&gt; y Then    
              If DateToCompare &gt;= Cells(y, StartColumn) And DateToCompare &lt;= Cells(y, StartColumn + 1) And HireCar = Cells(y, 2) Then
                  'We should highlight both cells that contain overlapping dates
                  ActiveSheet.Cells(i, StartColumn).Interior.Color = 5296274
                  ActiveSheet.Cells(y, StartColumn).Interior.Color = 5296274
              End If
          End If
      Next y
  Next i
  
  HireCar = 0
  
  'Check EndDate Column
  For i = StartLine To EndLine
  
      DateToCompare = Cells(i, StartColumn + 1)
      HireCar = Cells(i, StartColumn - 1)
      For y = StartLine To EndLine
          'If we are at the same line with DateToCompare cell then we should not perform any check
          If i &lt;&gt; y Then    
              If DateToCompare &gt;= Cells(y, StartColumn) And DateToCompare &lt;= Cells(y, StartColumn + 1) And HireCar = Cells(y, StartColumn - 1) Then
                  'We should highlight both cells that contain overlapping dates
                  ActiveSheet.Cells(i, StartColumn + 1).Interior.Color = 5296274
                  ActiveSheet.Cells(y, StartColumn + 1).Interior.Color = 5296274
              End If
          End If
      Next y
  Next i
  
  
  'Last check: If the starting and ending date are the same
  For i = StartLine To EndLine
      If Cells(i, StartColumn) - Cells(i, StartColumn + 1) = 0 Then
          ActiveSheet.Cells(i, StartColumn).Interior.Color = 5296274
          ActiveSheet.Cells(i, StartColumn + 1).Interior.Color = 5296274
      End If
  Next i
  
  ' If there are no Overlap Days in Database skip filtering
  ' StartDate and EndDate Column
  ' Count Cells with Interior.Color = 5296274 (Green Colour)
  Count = 0
  
  For i = StartLine To EndLine
      If Cells(i, StartColumn).Interior.Color = 5296274 Then
          Count = Count + 1
      End If
  Next i
  
  ' Msg if Database has no Overlap Days
  Msg = "Validation check completed. There are 'NO' Overlap Days"
  Style = vbOKOnly
  Title = "Cash Flow"
  
  ' Require on Error Resume Next in case Database is NOT filtered
  On Error Resume Next
  If Count = 0 Then
      ActiveSheet.ShowAllData
      Response = MsgBox(Msg, Style, Title)
      Exit Function
  Else
      Call Filter_Colour
  End If
  
  MsgBox "Any Green highlights indicate Overlap Days"
  </code></pre>
  
  <p>End Function</p>