Overlap dates to highlight

sathishsusa
Mar 18th 2017
Thread is marked as Resolved.

sathishsusa

Beginner

Points

210

Posts

28
Mar 18th 2017
- #1
[INDENT]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.[/INDENT]
[Blocked Image: http://www.vbaexpress.com/forum/images/misc/paperclip.png] Attached Files
Files

datesover.xlsm 17.43 kB – 106 Downloads

Mar 19th 2017

#2

Re: Overlap dates to highlight

Try this for Range B4 to E12 and CheckBoxes in Range AS8 & to AT11. Change ranges in code as appropriate to new data.

Code

Sub ALeave()
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

Display More

sathishsusa

Beginner

Points

210

Posts

28
Mar 19th 2017
- #3
Re: Overlap dates to highlight

Hi MickG,

what a man you are Mick , thanks a lot very much its working perfect for this i trying lot of more than a months i spinning my head to find out the solution.

u really made my day mickG.:drum:
MickG

Intermediate

Points

1,100

Posts

220
Mar 19th 2017
- #4
Re: Overlap dates to highlight

You're welcome
NoSparks

Beginner

Points

290

Posts

58
Mar 19th 2017
- #5
Re: Overlap dates to highlight

sathishsusa, be sure you go to all cross posting of this question and give credit for the solution.
sathishsusa

Beginner

Points

210

Posts

28
Mar 20th 2017
- #6
Re: Overlap dates to highlight

Dear Nosparks,

its very long ago i posted for different solution but other new thing which i posted its some to same project only. if any mistake and wrong on me i am sorry sparks.

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login

Share

This site uses cookies. By continuing to browse this site, you are agreeing to our use of cookies. More Details Close

Your browser has JavaScript disabled. If you would like to use all features of this site, it is mandatory to enable JavaScript.