identify Highlight Overlap dates

[sathishsusa]

I have a Four Employees. Each employee they want to prepare a leave plan for year 2017. If employees, they want to apply leave Rule is there should not be any overlap date with other employee’s dates.

Now I wish to compare the employees overlap dates by selecting the checkbox. In case any overlapping dates between the employees then I need to highlight the overlap, Column has red color in cells and also, I need the pop up message for overlap dates.

Else

If no any overlap, then pop up messages says like “there is no overlap between selecting employees”.

Finally I need the results to find the overlap dates to highlight so , forums experts if u have any suggestion or idea to solve this problem It will most great help for me. In case u need any more information on this problem to solve. Please let me know
Many sites and Google I searched I could find the correct solution for this but if solved many of them looking similar to find easy method for leave plan for overlap dates.

Pls refer the updated attachment to find for solution.

[werafa]

Hi,

I've not got time to go into details, but here is a start.
You have 4 employees, so you have 4 x DateFrom and 4 x DateTo values to deal with.

step 1: get the input data.
create 2 arrays. eg. myDateFrom(1 to 4) and myDateTo(1 to 4) as date arrays, then read your dates into them

Step 2: Test for overlaps
You need to test each date to see if the start date of any employee is >= to the start date of any other, AND <= the end date of any other employee, and vice versa for the end date. Create a boolean variable to hold the results of the test (eg myFlag)

Step 3: Respond to a failed test
If either the start date or the end date are disqualified (myFlag = false), run a message box and force the selection of a new date. else run any msgbox you wish.

Werafa

[sathishsusa]

Hi Werafa,
first of all thanks you very much for your reply.. for this problem i am waiting for long days and spinning my head.

yes the step which u said its right i need the result same as what u mention on it.

[werafa]

that is ok.

when you come to vba, you should always break the problem down into steps, and code each step separately.
one easy rule is; a sub should fit onto one screen.

so your code will look like



Sub MasterSub()
call step1
call step2
end sub

Sub Step1()
some code goes here
end sub

Sub Step2()
some code goes here
end sub

[sathishsusa]

werafa,

i am a new for vba.. i just started learning vba by looking forums

if you don't mind please help me can u provide me the code to go through on it. it will be most helpful for me.

[sathishsusa]

please help me ...

[sathishsusa]

Hi Werafa,

Thanks problems is solved.

[mdmackillop]

Please post your solution for the benefit of others.

[sathishsusa]

Thanks..



Sub overlap()
Dim Rng As Range, Dn As Range, n As Long, Cb As Range, Dt As Date
Dim Dic As Object, Msg As String, CbRng As Range, nStr As String, Sp As Variant
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Set CbRng = Range("AS8:AS11")

For Each Cb In CbRng
If Cb Then
nStr = nStr & IIf(nStr = "", Cb.Offset(, 1).Value, ", " & Cb.Offset(, 1).Value)
End If
Next Cb
Sp = Split(nStr, ", ")
Set Rng = Range("B7:B12")
Rng.Offset(, 3).Interior.Color = 49407
If UBound(Sp) > 0 Then
For n = 0 To UBound(Sp)
For Each Dn In Rng
If Dn.Value = Sp(n) Then
For Dt = Dn.Offset(, 1).Value To Dn.Offset(, 2).Value
If Not Dic.Exists(Dt) Then
Dic.Add Dt, Dn
Else
Set Dic(Dt) = Union(Dic(Dt), Dn)
Dic(Dt).Offset(, 3).Interior.Color = vbRed
End If
Next Dt
End If
Next Dn
Next n
End If
Dim K As Variant, Temp As String, nRng As Range, R As Range
For Each K In Dic.keys
If Dic(K).Count > 1 Then
If nRng Is Nothing Then Set nRng = Dic(K) Else Set nRng = Union(nRng, Dic(K))
End If
Next K
If Not nRng Is Nothing Then
For Each R In nRng
Msg = Msg & "Overlap Dates" & vbLf & R.Value & " From:- " & R.Offset(, 1).Value & " To " & R.Offset(, 2).Value & vbLf
Next R
MsgBox Msg
Else
MsgBox "No overlap Dates Between " & nStr
End If
End Sub

[NoSparks]

common courtesy would be to give credit where credit is due

http://www.ozgrid.com/forum/showthread.php?t=203381

[sathishsusa]

Yes you are right but I given the credit to him and those who helped me also only thing I forget to paste the link. I am respect to other and forums too helping people but sorry spark what happened today I apologized to everyone one and admin thanks for your kind advice.