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
Data Validation (Custom formula) in U2 of ..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.
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:
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.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
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
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
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
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