data validation non contiguous cells

hajiali

Well-known Member
Joined
Sep 8, 2018
Messages
626
Office Version
  1. 2016
Platform
  1. Windows
Hello I have non contiguous range ($U$2:$AS$1000 and $AW$2:$BF$1000) I need a data validation to alert users when the same date is entered in both range combine more than 12 time.


Thanks
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
I am not sure how you would do that with Data Validation, but it can be done with VBA. We can use a Worksheet_Change event procedure, which is VBA code that will run autoamtically, as manual entries are made, one cell at a time.

So, to use the following code, go to the sheet you would like to apply this to, right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this code in the resulting VB Editor window:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, rng2 As Range
    
'   Set two ranges to check
    Set rng1 = Range("$U$2:$AS$1000")
    Set rng2 = Range("$AW$2:$BF$1000")

'   Exit sub if more than one cell is updated at a time
    If Target.CountLarge > 1 Then Exit Sub
    
'   Exit sub if updated cells does not fall in one of our ranges
    If (Intersect(Target, rng1) Is Nothing) And (Intersect(Target, rng2) Is Nothing) Then Exit Sub
    
'   See how many times entry appears in range
    If IsDate(Target) Then
        If Application.WorksheetFunction.CountIf(rng1, Target.Value) + _
            Application.WorksheetFunction.CountIf(rng2, Target.Value) > 12 Then
            MsgBox "That date appears more than 12 times!"
        End If
    End If
    
End Sub
So, if the date you entered into those ranges already exists in them 12 or more times, you will get a message alerting you of that fact.
 
Upvote 0
Hello I have non contiguous range ($U$2:$AS$1000 and $AW$2:$BF$1000) I need a data validation to alert users when the same date is entered in both range combine more than 12 time.
Data Validation (Custom formula) in U2 of ..
=COUNTIF($U$2:$AS$1000,U2)+COUNTIF($AW$2:$BF$1000,U2)<=12
.. & copied to the rest of the two ranges would prevent an entry being made more that 12 times. It will not differentiate between dates and any other type of entry though.
 
Upvote 0
I am not sure how you would do that with Data Validation, but it can be done with VBA. We can use a Worksheet_Change event procedure, which is VBA code that will run autoamtically, as manual entries are made, one cell at a time.

So, to use the following code, go to the sheet you would like to apply this to, right-click on the sheet tab name at the bottom of the screen, select "View Code", and paste this code in the resulting VB Editor window:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng1 As Range, rng2 As Range
    
'   Set two ranges to check
    Set rng1 = Range("$U$2:$AS$1000")
    Set rng2 = Range("$AW$2:$BF$1000")

'   Exit sub if more than one cell is updated at a time
    If Target.CountLarge > 1 Then Exit Sub
    
'   Exit sub if updated cells does not fall in one of our ranges
    If (Intersect(Target, rng1) Is Nothing) And (Intersect(Target, rng2) Is Nothing) Then Exit Sub
    
'   See how many times entry appears in range
    If IsDate(Target) Then
        If Application.WorksheetFunction.CountIf(rng1, Target.Value) + _
            Application.WorksheetFunction.CountIf(rng2, Target.Value) > 12 Then
            MsgBox "That date appears more than 12 times!"
        End If
    End If
    
End Sub
So, if the date you entered into those ranges already exists in them 12 or more times, you will get a message alerting you of that fact.

Note sure what going on. I tried the above code it does not seem to work.

I also have the following code in that sheet which allows me to double click on another range do not thing that this would interfere?

Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)    If Not Intersect(Target, Range("M2:O1000")) Is Nothing Then
        Application.EnableEvents = False
        If ActiveCell.Value = "X" Then
            ActiveCell.ClearContents
        Else
            ActiveCell.Value = "X"
        End If
        Cancel = True
    End If
    Application.EnableEvents = True
End Sub
 
Upvote 0
Thanks Peter. I really need this to work for Dates as that is the only data that will be inputted in these ranges.
 
Upvote 0
I don't think that code should interfere.

You are manually inputting those dates in the range, right?
Are you entering a certain date more than 12 times?

Many turn on the Macro Recorder, and record yourself entering a situation which should trigger the code to run, then stop the Macro Recorder, and post the code here.
Then, I can try to recreate the exact thing you are doing and check to see if my code works on it.
 
Upvote 0
You are manually inputting those dates in the range, right? YES
Are you entering a certain date more than 12 times? YES

Code:
Sub Macro1()'
' Macro1 Macro
'


'
    Range("U4").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("U11").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("U16").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("U22").Select
    ActiveCell.FormulaR1C1 = "1/12020"
    Range("U22").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("U28").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AD33").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AL36").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AL38").Select
    ActiveWindow.SmallScroll Down:=24
    ActiveWindow.SmallScroll ToRight:=24
    Range("AX43").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AX48").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AX53").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("BB60").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("BB64").Select
    ActiveWindow.SmallScroll Down:=9
    Range("AX70").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AX79").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AX84").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("BB86").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("BB89").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("BB91").Select
    ActiveWindow.SmallScroll Down:=3
    Range("AG90").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AG94").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AG97").Select
    ActiveCell.FormulaR1C1 = "1/1/2020"
    Range("AG99").Select
End Sub

so for above ex. I entered 1/1/2020 more than 12 times it did noting. I want it to give a warning when any date that is entered 12 times.
 
Upvote 0
Hi @hajiali, In Peter's validation, if you copy the value more than 12 times it does not verify. Same with Joe's code.


If you are going to capture one or several dates at once, try the following:


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r1 As Range, r2 As Range, c As Range
  Set r1 = Range("$U$2:$AS$1000")
  Set r2 = Range("$AW$2:$BF$1000")
  If Target.Count > Union(r1, r2).Count Then Exit Sub
  On Error GoTo AppEnable
  If Not Intersect(Target, Union(r1, r2)) Is Nothing Then
    Application.EnableEvents = False
    For Each c In Target
      If c.Value <> "" Then
        If WorksheetFunction.CountIf(r1, c.Value) + WorksheetFunction.CountIf(r2, c.Value) > 12 Then
          MsgBox "Same date is entered more than 12 time: " & c.Value
          Target.Value = ""
        End If
    End If
    Next
    Application.EnableEvents = True
  End If
AppEnable:
Application.EnableEvents = True
End Sub

Note: Under the code you can put your DoubleClick code without problem.
 
Upvote 0
DanteAmor thank you for this code works great. I want it just to be a warning and allow user if they want to continue Yes or No, if Yes then apply date if no than end
 
Upvote 0
Try this

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r1 As Range, r2 As Range, c As Range, resp As Variant
  Set r1 = Range("$U$2:$AS$1000")
  Set r2 = Range("$AW$2:$BF$1000")
  If Target.Count > Union(r1, r2).Count Then Exit Sub
  On Error GoTo AppEnable
  If Not Intersect(Target, Union(r1, r2)) Is Nothing Then
    Application.EnableEvents = False
    For Each c In Target
      If c.Value <> "" Then
        If WorksheetFunction.CountIf(r1, c.Value) + WorksheetFunction.CountIf(r2, c.Value) > 12 Then
          resp = MsgBox("Same date is entered more than 12 time: " & c.Value & vbCr & vbCr & _
            "Do you want to continue?", vbQuestion & vbYesNo)
          Select Case resp
            Case vbNo
              Target.Value = ""
            Case vbYes
              Exit For
          End Select
        End If
      End If
    Next
    Application.EnableEvents = True
  End If
AppEnable:
Application.EnableEvents = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,744
Messages
6,174,253
Members
452,553
Latest member
red83

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top