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.