Hi,
I have tried to figure out how to combine the Worksheet_Change events below to run in the same worksheet.
Any help your guidance would be highly appreciated.
I have tried to figure out how to combine the Worksheet_Change events below to run in the same worksheet.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aFullList As Variant, aRejects As Variant, vReject As Variant
Dim aResults(1 To 30, 1 To 1) As Variant
Dim i As Long, lSize As Long, k As Long
If Not Intersect(Target, Union(Range("D2"), Range("I2:N18"))) Is Nothing Then
lSize = Range("D2").Value
If lSize > 0 Then
aFullList = Application.Transpose(Evaluate("row(1:" & 30 * lSize & ")"))
aRejects = Range("I2:N18").Value
For Each vReject In aRejects
If Not IsEmpty(vReject) Then
aFullList(vReject) = "x"
End If
Next vReject
aFullList = Filter(aFullList, "x", False)
For i = lSize - 1 To UBound(aFullList) Step lSize
k = k + 1
aResults(k, 1) = aFullList(i)
Next i
If aResults(k, 1) <> aFullList(UBound(aFullList)) Then aResults(k + 1, 1) = aFullList(UBound(aFullList))
End If
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="xxx"
Range("B2:B31").Value = aResults
ActiveSheet.Protect Password:="xxx"
Application.EnableEvents = True
End If
End Sub
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim EvalRange As Range
'Set the range where you want to prevent duplicate entries.
Set EvalRange = Range("I2:N18")
'If the cell where value was entered is not in the defined range, if the value pasted is larger than a single cell,
'or if no value was entered in the cell, then exit the macro.
If Intersect(Target, EvalRange) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
'If the value entered already exists in the defined range on the current worksheet, throw an
'error message and undo the entry.
If WorksheetFunction.CountIf(EvalRange, Target.Value) > 1 Then
MsgBox Target.Value & " already exists on this sheet."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Any help your guidance would be highly appreciated.