How can I run the two below at the same time. I get an Ambiguous name detected error in VBA if i try to run them at the same time.
VBA 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
' See if any updated cells fall in H4:H500
Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If isect Is Nothing Then Exit Sub
Application.EnableEvents = False
' Set drop-down values
dd = Array("Apple", "orange", "Grape")
' Loop through all intersecting cells
For Each cell In isect
' See if cell entry matches any drop-down values
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
' If value is not in list, erase and return message
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
' Build string of validation entries
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
' Reset validation
With Range("H4:H500").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
' Return message, if necessary
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
Application.EnableEvents = True
End Sub
VBA 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
' See if any updated cells fall in G4:G500
Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If isect Is Nothing Then Exit Sub
Application.EnableEvents = False
' Set drop-down values
dd = Array("yellow", "blue", "green")
' Loop through all intersecting cells
For Each cell In isect
' See if cell entry matches any drop-down values
mtch = False
For i = LBound(dd) To UBound(dd)
If cell.Value = dd(i) Then
mtch = True
Exit For
End If
Next i
' If value is not in list, erase and return message
If mtch = False Then
cell.ClearContents
msg = msg & cell.Address(0, 0) & ","
End If
Next cell
' Build string of validation entries
For i = LBound(dd) To UBound(dd)
myEntries = myEntries & dd(i) & ","
Next i
myEntries = Left(myEntries, Len(myEntries) - 1)
' Reset validation
With Range("G4:G500").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
' Return message, if necessary
If Len(msg) > 0 Then
MsgBox "Invalid entries in cells: " & vbCrLf & Left(msg, Len(msg) - 1), vbOKOnly, "ERROR!"
End If
Application.EnableEvents = True
End Sub