Hi all,
I found (maybe on this website) this code which works perfectly on its own. I need to block users in shared excel to copy paste values that arent in the drop down menu.
For one column it works just fine but I need to prevent this in multiple columns and the data is different for each one. I tried removing Exit Subs and continuing with the next change, but I am a complete beginner, I must be doing something wrong.
The Range and Values change eg:
Set isect = Intersect(Range("O9:O30"), Target)
dd = Array("BLUE", "RED", "")
Set isect = Intersect(Range("N9:N30"), Target)
dd = Array("BLACK", "YELLOW", "GRAY", "")
Set isect = Intersect(Range("M9:M30"), Target)
dd = Array("GOLD", "GREEN","PINK", "WHITE", "")
This is just an example, I cant post the real data. Here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim cell As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String
Set isect = Intersect(Range("O9:O30"), Target)
If isect Is Nothing Then Exit Sub
Application.EnableEvents = False
dd = Array("BLUE", "RED", "")
For Each cell In isect
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
With Range("O9:O30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries
' .IgnoreBlank = True
' .InCellDropdown = True
' .InputTitle = ""
' .ErrorTitle = ""
' .InputMessage = ""
' .ErrorMessage = ""
' .ShowInput = True
' .ShowError = True
End With
If Len(msg) > 0 Then
MsgBox "Invalid data in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "Error"
End If
Application.EnableEvents = True
End Sub
I appreciate any help, thank you very much!
I found (maybe on this website) this code which works perfectly on its own. I need to block users in shared excel to copy paste values that arent in the drop down menu.
For one column it works just fine but I need to prevent this in multiple columns and the data is different for each one. I tried removing Exit Subs and continuing with the next change, but I am a complete beginner, I must be doing something wrong.
The Range and Values change eg:
Set isect = Intersect(Range("O9:O30"), Target)
dd = Array("BLUE", "RED", "")
Set isect = Intersect(Range("N9:N30"), Target)
dd = Array("BLACK", "YELLOW", "GRAY", "")
Set isect = Intersect(Range("M9:M30"), Target)
dd = Array("GOLD", "GREEN","PINK", "WHITE", "")
This is just an example, I cant post the real data. Here is the code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim cell As Range
Dim dd As Variant
Dim i As Long
Dim mtch As Boolean
Dim msg As String
Dim myEntries As String
Set isect = Intersect(Range("O9:O30"), Target)
If isect Is Nothing Then Exit Sub
Application.EnableEvents = False
dd = Array("BLUE", "RED", "")
For Each cell In isect
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
With Range("O9:O30").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=myEntries
' .IgnoreBlank = True
' .InCellDropdown = True
' .InputTitle = ""
' .ErrorTitle = ""
' .InputMessage = ""
' .ErrorMessage = ""
' .ShowInput = True
' .ShowError = True
End With
If Len(msg) > 0 Then
MsgBox "Invalid data in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "Error"
End If
Application.EnableEvents = True
End Sub
I appreciate any help, thank you very much!
