Comparing two range of dates

C

CrispyAsian

Board Regular
Joined
Sep 22, 2017
Messages
64
Hey everyone,

So I have a bit of a conundrum with a code I've been working on. So currently I have this code running:

Code: 
Option Explicit


Public SelectItem3 As String, pos3 As Long


Private Sub AddDate()


Dim b As Object, RowNumber As Integer
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
    RowNumber = .Row
End With


Application.ScreenUpdating = False


Sheets("Sheet2").Visible = True


Load Course_Add


SelectItem3 = "": pos3 = 0


With Course_Add
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
  .Show
End With


 If pos3 = 0 Then
    GoTo Line4
    End If


Dim UserValue1 As Variant
Dim UserValue2 As Variant


GoTo Line1


Line1:


    UserValue1 = InputBox("Please Enter Earliest Preferred Start Date (mm/dd/yyyy)")


    If StrPtr(UserValue1) = 0 Then
    
    GoTo Line4


    ElseIf UserValue1 = "" Then
    
    GoTo Line4
    
    End If
    
    UserValue1 = CDate(UserValue1)
    
    If UserValue1 < DateValue("November 1, 2017") Or UserValue1 > DateValue("December 31, 2018") Then
    
    MsgBox "This is not a valid date"
    
    GoTo Line1
    
    Else
    
    GoTo Line2
    
    End If
    
Line2:
    
    UserValue2 = InputBox("Please Enter Latest Preferred Start Date (mm/dd/yyyy)")
    
    If StrPtr(UserValue2) = 0 Then
        
    GoTo Line4


    ElseIf UserValue2 = "" Then
        
    GoTo Line4
    
    End If
    
    UserValue2 = CDate(UserValue2)
        
        If UserValue2 < DateValue("November 1, 2017") Or UserValue2 > DateValue("December 31, 2018") Then
    
        MsgBox "This is not a valid date"
    
        GoTo Line2
        
        ElseIf DateValue(UserValue2) <= DateValue(UserValue1) Then
        
        MsgBox "Latest date cannot be earlier than Earliest Date.  Please enter a date that is later than Earliest Preferred Date."
        
        GoTo Line2


        Else
        
        Dim c As Long
        Dim cell As Range
        Dim datecolumn As Integer
        Dim dateseparation As Integer
        Dim y As Long
        
        datecolumn = DateDiff("d", "10/31/2017", UserValue1) + 5
            dateseparation = DateDiff("d", UserValue1, UserValue2)
                With ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowNumber, datecolumn), Cells(RowNumber, datecolumn + dateseparation))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Merge
                    .Interior.ColorIndex = 6
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlMedium
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlMedium
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlMedium
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlMedium
                    .Value = SelectItem3 & " " & UserValue1 & "-" & UserValue2
                    .Font.Size = 6
                    .Font.Color = vbBlack
                    .Font.Bold = True
                End With
        End If
    


Line4:


Sheets("Sheet2").Visible = False


Application.ScreenUpdating = True
    


End Sub

That produces this yellow block on "sheet1" whenever someone presses the Add to Course button next to someones name:

f15tGe7.jpg


My problem is, hidden on sheet two is all the data for the rest of the Sheet1. It looks like this:

KePETG8.jpg


I need to compare if any of the dates between UserValue1 - UserValue2 overlap any of the date on sheet2 for the SelectItem3 that will match up with one of the row categories. If they do overlap, I want the cells that do overlap to be green and cell that don't to be red. So for example with the pictures above. All the cells would be red. But say that UserValue2 was "3/15/2018". Then all the cells that represent "3/5/2018 - 3/15/2018" would be green. Anybody got any ideas?
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
So I tried working on it a little myself and this is what I came up with:

Code: 
Option Explicit


Public SelectItem3 As String, pos3 As Long


Private Sub AddDate()


Dim b As Object, RowNumber As Integer
Set b = ActiveSheet.Buttons(Application.Caller)
RowNumber = 0
With b.TopLeftCell
    RowNumber = .Row
End With


Application.ScreenUpdating = False


Sheets("Sheet2").Visible = True


Load Course_Add


SelectItem3 = "": pos3 = 0


With Course_Add
  .StartUpPosition = 0
  .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
  .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
  .Show
End With


 If pos3 = 0 Then
    GoTo Line4
    End If


Dim UserValue1 As Variant
Dim UserValue2 As Variant


GoTo Line1


Line1:


    UserValue1 = InputBox("Please Enter Earliest Preferred Start Date (mm/dd/yyyy)")


    If StrPtr(UserValue1) = 0 Then
    
    GoTo Line4


    ElseIf UserValue1 = "" Then
    
    GoTo Line4
    
    End If
    
    UserValue1 = CDate(UserValue1)
    
    If UserValue1 < DateValue("November 1, 2017") Or UserValue1 > DateValue("December 31, 2018") Then
    
    MsgBox "This is not a valid date"
    
    GoTo Line1
    
    Else
    
    GoTo Line2
    
    End If
    
Line2:
    
    UserValue2 = InputBox("Please Enter Latest Preferred Start Date (mm/dd/yyyy)")
    
    If StrPtr(UserValue2) = 0 Then
        
    GoTo Line4


    ElseIf UserValue2 = "" Then
        
    GoTo Line4
    
    End If
    
    UserValue2 = CDate(UserValue2)
        
        If UserValue2 < DateValue("November 1, 2017") Or UserValue2 > DateValue("December 31, 2018") Then
    
        MsgBox "This is not a valid date"
    
        GoTo Line2
        
        ElseIf DateValue(UserValue2) <= DateValue(UserValue1) Then
        
        MsgBox "Latest date cannot be earlier than Earliest Date.  Please enter a date that is later than Earliest Preferred Date."
        
        GoTo Line2


        Else
[COLOR=#ffff00]        [/COLOR]
[COLOR=#ff0000]        Dim c As Long[/COLOR]
[COLOR=#ff0000]        Dim cell As Range[/COLOR]
[COLOR=#ff0000]        Dim datecolumn As Integer[/COLOR]
[COLOR=#ff0000]        Dim dateseparation As Integer[/COLOR]
[COLOR=#ff0000]        Dim y As Long[/COLOR]
[COLOR=#ff0000]        Dim i As Integer[/COLOR]
[COLOR=#ff0000]        Dim SDates() As String[/COLOR]
[COLOR=#ff0000]        Dim datecolumn2 As Integer[/COLOR]
[COLOR=#ff0000]        Dim datecolumn3 As Integer[/COLOR]
[COLOR=#ff0000]        [/COLOR]
[COLOR=#ff0000]        i = 0[/COLOR]
[COLOR=#ff0000]        [/COLOR]
[COLOR=#ff0000]        Select Case SelectItem3[/COLOR]
[COLOR=#ff0000]                Case Is = "UTMB"[/COLOR]
[COLOR=#ff0000]                    i = 1[/COLOR]
[COLOR=#ff0000]                Case Is = "FSMB"[/COLOR]
[COLOR=#ff0000]                    i = 2[/COLOR]
[COLOR=#ff0000]                Case Is = "AF CTSAC"[/COLOR]
[COLOR=#ff0000]                    i = 3[/COLOR]
[COLOR=#ff0000]                Case Is = "AIS"[/COLOR]
[COLOR=#ff0000]                    i = 4[/COLOR]
[COLOR=#ff0000]                Case Is = "AMIC"[/COLOR]
[COLOR=#ff0000]                    i = 5[/COLOR]
[COLOR=#ff0000]                Case Is = "ASPM"[/COLOR]
[COLOR=#ff0000]                    i = 6[/COLOR]
[COLOR=#ff0000]                Case Is = "BPC"[/COLOR]
[COLOR=#ff0000]                    i = 7[/COLOR]
[COLOR=#ff0000]                Case Is = "BV7CE"[/COLOR]
[COLOR=#ff0000]                    i = 8[/COLOR]
[COLOR=#ff0000]                Case Is = "CTSOF"[/COLOR]
[COLOR=#ff0000]                    i = 9[/COLOR]
[COLOR=#ff0000]                Case Is = "INSOF"[/COLOR]
[COLOR=#ff0000]                    i = 10[/COLOR]
[COLOR=#ff0000]                Case Is = "IROC"[/COLOR]
[COLOR=#ff0000]                    i = 11[/COLOR]
[COLOR=#ff0000]                Case Is = "JAOC2C"[/COLOR]
[COLOR=#ff0000]                    i = 12[/COLOR]
[COLOR=#ff0000]                Case Is = "JAOPC"[/COLOR]
[COLOR=#ff0000]                    i = 13[/COLOR]
[COLOR=#ff0000]                Case Is = "JEMIC"[/COLOR]
[COLOR=#ff0000]                    i = 14[/COLOR]
[COLOR=#ff0000]                Case Is = "JFC"[/COLOR]
[COLOR=#ff0000]                    i = 15[/COLOR]
[COLOR=#ff0000]                Case Is = "JT-101"[/COLOR]
[COLOR=#ff0000]                    i = 16[/COLOR]
[COLOR=#ff0000]                Case Is = "JT-102 MAJIC"[/COLOR]
[COLOR=#ff0000]                    i = 17[/COLOR]
[COLOR=#ff0000]                Case Is = "JT-201"[/COLOR]
[COLOR=#ff0000]                    i = 18[/COLOR]
[COLOR=#ff0000]                Case Is = "JT-220"[/COLOR]
[COLOR=#ff0000]                    i = 19[/COLOR]
[COLOR=#ff0000]                Case Is = "JT-301 JICO"[/COLOR]
[COLOR=#ff0000]                    i = 20[/COLOR]
[COLOR=#ff0000]                Case Is = "JT-310 AJOC"[/COLOR]
[COLOR=#ff0000]                    i = 21[/COLOR]
[COLOR=#ff0000]                Case Is = "PTSOF"[/COLOR]
[COLOR=#ff0000]                    i = 22[/COLOR]
[COLOR=#ff0000]                Case Is = "SV8ES"[/COLOR]
[COLOR=#ff0000]                    i = 23[/COLOR]
[COLOR=#ff0000]            End Select[/COLOR]
[COLOR=#ff0000]        [/COLOR]
[COLOR=#ff0000]        With Sheets("Sheet2")[/COLOR]
[COLOR=#ff0000]            For y = 2 To 52[/COLOR]
[COLOR=#ff0000]                If Len(.Cells(i, y).Value) > 0 And InStr(.Cells(i, y).Value, " - ") Then[/COLOR]
[COLOR=#ff0000]                SDates = Split(Sheets("Sheet2").Cells(i, y).Value, " - ")[/COLOR]
[COLOR=#ff0000]                End If[/COLOR]
[COLOR=#ff0000]                [/COLOR]
[COLOR=#ff0000]        datecolumn3 = DateDiff("d", "10/31/2017", SDates(0)) + 5[/COLOR]
[COLOR=#ff0000]        datecolumn2 = DateDiff("d", "10/31/2017", SDates(1)) + 5[/COLOR]
[COLOR=#ff0000]        datecolumn = DateDiff("d", "10/31/2017", UserValue1) + 5[/COLOR]
[COLOR=#ff0000]        dateseparation = DateDiff("d", UserValue1, UserValue2)[/COLOR]
[COLOR=#ff0000]        [/COLOR]
[COLOR=#ff0000]    If UserValue1 >= SDates(0) And UserValue1 <= SDates(1) Then[/COLOR]
[COLOR=#ff0000]         If UserValue2 <= SDates(1) Then[/COLOR]
[COLOR=#ff0000]                With ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowNumber, datecolumn), Cells(RowNumber, datecolumn + dateseparation))[/COLOR]
[COLOR=#ff0000]                    .HorizontalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .VerticalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .Merge[/COLOR]
[COLOR=#ff0000]                    .Interior.ColorIndex = 4[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeLeft).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeLeft).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeRight).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeRight).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Value = SelectItem3 & " " & UserValue1 & "-" & UserValue2[/COLOR]
[COLOR=#ff0000]                    .Font.Size = 6[/COLOR]
[COLOR=#ff0000]                    .Font.Color = vbBlack[/COLOR]
[COLOR=#ff0000]                    .WrapText = True[/COLOR]
[COLOR=#ff0000]                End With[/COLOR]
[COLOR=#ff0000]            Else[/COLOR]
[COLOR=#ff0000]                With ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowNumber, datecolumn), Cells(RowNumber, datecolumn2))[/COLOR]
[COLOR=#ff0000]                    .HorizontalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .VerticalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .Merge[/COLOR]
[COLOR=#ff0000]                    .Interior.ColorIndex = 4[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeLeft).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeLeft).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Value = SelectItem3 & " " & UserValue1 & "-" & UserValue2[/COLOR]
[COLOR=#ff0000]                    .Font.Size = 6[/COLOR]
[COLOR=#ff0000]                    .Font.Color = vbBlack[/COLOR]
[COLOR=#ff0000]                    .WrapText = True[/COLOR]
[COLOR=#ff0000]                End With[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]                With ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowNumber, datecolumn2), Cells(RowNumber, datecolumn + dateseparation))[/COLOR]
[COLOR=#ff0000]                    .HorizontalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .VerticalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .Merge[/COLOR]
[COLOR=#ff0000]                    .Interior.ColorIndex = 3[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeRight).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeRight).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Value = SelectItem3 & " " & UserValue1 & "-" & UserValue2[/COLOR]
[COLOR=#ff0000]                    .Font.Size = 6[/COLOR]
[COLOR=#ff0000]                    .Font.Color = vbBlack[/COLOR]
[COLOR=#ff0000]                    .WrapText = True[/COLOR]
[COLOR=#ff0000]                End With[/COLOR]
[COLOR=#ff0000]            End If[/COLOR]
[COLOR=#ff0000]            GoTo Line4[/COLOR]
[COLOR=#ff0000]        ElseIf UserValue2 >= SDates(0) And UserValue2 <= SDates(1) Then[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]                With ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowNumber, datecolumn), Cells(RowNumber, datecolumn3))[/COLOR]
[COLOR=#ff0000]                    .HorizontalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .VerticalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .Merge[/COLOR]
[COLOR=#ff0000]                    .Interior.ColorIndex = 3[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeLeft).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeLeft).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Value = SelectItem3 & " " & UserValue1 & "-" & UserValue2[/COLOR]
[COLOR=#ff0000]                    .Font.Size = 6[/COLOR]
[COLOR=#ff0000]                    .Font.Color = vbBlack[/COLOR]
[COLOR=#ff0000]                    .WrapText = True[/COLOR]
[COLOR=#ff0000]                End With[/COLOR]
[COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000]                With ThisWorkbook.Worksheets("Sheet1").Range(Cells(RowNumber, datecolumn3), Cells(RowNumber, datecolumn + dateseparation))[/COLOR]
[COLOR=#ff0000]                    .HorizontalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .VerticalAlignment = xlCenter[/COLOR]
[COLOR=#ff0000]                    .Merge[/COLOR]
[COLOR=#ff0000]                    .Interior.ColorIndex = 4[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeRight).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeRight).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeBottom).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).LineStyle = xlContinuous[/COLOR]
[COLOR=#ff0000]                    .Borders(xlEdgeTop).Weight = xlMedium[/COLOR]
[COLOR=#ff0000]                    .Value = SelectItem3 & " " & UserValue1 & "-" & UserValue2[/COLOR]
[COLOR=#ff0000]                    .Font.Size = 6[/COLOR]
[COLOR=#ff0000]                    .Font.Color = vbBlack[/COLOR]
[COLOR=#ff0000]                    .WrapText = True[/COLOR]
[COLOR=#ff0000]                End With[/COLOR]
[COLOR=#ff0000]                GoTo Line4[/COLOR]
[COLOR=#ff0000]           Else[/COLOR]
[COLOR=#ff0000]            Erase SDates[/COLOR]
[COLOR=#ff0000]                End If[/COLOR]
[COLOR=#ff0000]            Next y[/COLOR]
[COLOR=#ff0000]        End With[/COLOR]
[COLOR=#ff0000]    End If[/COLOR]
[COLOR=#ff0000]    [/COLOR]


Line4:


Sheets("Sheet2").Visible = False


Application.ScreenUpdating = True
    


End Sub

Unfortunately, it does almost exactly the opposite of what I need it to do and it makes the date block come out at a seemingly random cell. Can anybody tell me what I'm doing wrong? Any help would be greatly appreciated!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA_Daily Average Vol
Replies
1
Views
413
offthelip
O
B
  • Question
Vlookup Between Two Dates From a Range of Dates
Replies
4
Views
3K
DanteAmor
DanteAmor
M
  • Question
Need help please with excel sheet
Replies
6
Views
486
magiciansmask
M
A
  • Question
Worksheet Change and WorksheetDoubleClick events Not Working - Poor range definitions?
Replies
1
Views
937
Ark68
A
kelly mort
  • Question
Customized Datepicker code amendment needed - (a bit complex task)
Replies
0
Views
2K
kelly mort
kelly mort

Forum statistics

Threads
1,216,747
Messages
6,132,481
Members
449,729
Latest member
davelevnt

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top