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:
That produces this yellow block on "sheet1" whenever someone presses the Add to Course button next to someones name:
My problem is, hidden on sheet two is all the data for the rest of the Sheet1. It looks like this:
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?
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:
My problem is, hidden on sheet two is all the data for the rest of the Sheet1. It looks like this:
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?