Macro To Stop me from using dates that are already in use?

[tonywatsonhelp]

Hi Everyone,

Not sure if this is possible, but hoping for best ideas.

I have a sheet I input Start dates and end dates into for my projects
Because one of my superpowers is not Duplicity I can only be in one place at a time but sometimes my brain forgets that!

So Simplisest solution when i choose to leave the page, check if any of the dates overlap?

So Startdates are down Column F from row 7 and End dates are Column G

if it helps the area i need checking is only F7:G16

any ideas

thanks

Tony

 

[RanOtherwise]

If you go to Data menu, and click Data Tools -> Data Validation, there is an option to set a rule where the validation type is Date, and you can set from and to dates, which can feed from other cells.

If you want to check all of your dates, you can use Custom validation type, and then enter your rule as a formula that checks max/min dates. This way, you can set it up to prevent you from entering a date in a range, but it might be a pretty complex formula.

Or, you can also set up some kind of conditional formatting to alert you that you entered an overlap / conflicting appointment.

Which way do you want to take?

 

[Logit]

.
If I understand your requirements correctly .... place this macro into the affected worksheet module. You will need to change
the sheet name in the macro as required :

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)


    Dim rCriteria As Range
    Dim rData As Range
    Dim c As Range, R As Range
    Dim sFirstAddress As String
    Dim ColorCounter As Long
    Dim StartTime As Single, EndTime As Single


Set rCriteria = Sheets(1).Range("F7:F17")
Set rData = Sheets(1).Range("G7:G17")


Application.ScreenUpdating = False


With rData
    .Interior.ColorIndex = xlNone


For Each R In rCriteria
    If Not R = "" Then
    Set c = .Find(what:=R.Value, LookIn:=xlValues, lookat:=xlWhole, _
            searchdirection:=xlNext)
    If Not c Is Nothing Then
        sFirstAddress = c.Address


        Do
            Set c = .FindNext(c)
            c.Interior.Color = vbYellow
            MsgBox "Duplicate Value ! ", vbCritical, "Duplicate Value"
            ColorCounter = ColorCounter + 1
        Loop Until c.Address = sFirstAddress
    End If
    End If
Next R


End With


Application.ScreenUpdating = True


End Sub

 

[Peter_SSs]

Could you just use Conditional Formatting?
Select F7:G16 and apply the CF shown.

Excel Workbook
	F	G
6	Start	End
7	1/01/2017	5/08/2017
8	6/08/2017	31/08/2017
9	15/09/2017	1/01/2018
10	27/08/2017	5/09/2017
11	22/02/2018	28/02/2018
12	28/02/2018	5/03/2018
13	19/03/2018	2/04/2018
14	4/03/2018	6/06/2018
15
16
Overlap Dates

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
F7	1. / Formula is =(SUMPRODUCT(($F$7:$F$16<$G7)*($G$7:$G$16>$F7))>1)*(COUNT($F7:$G7)=2)	Abc