2 Private Sub Worksheet_Change(ByVal Target As Range) ON SAME SHEET

an12drew

New Member
Joined
Dec 29, 2021
Messages
7
Office Version
  1. 365
Platform
  1. Windows
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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
You cannot have multiple change event codes in the same module, try it like
VBA Code:
Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
   'your code
End If

Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then
   'your other code
End If
Application.EnableEvents = True
End Sub
 
Upvote 0
You cannot have multiple change event codes in the same module, try it like
VBA Code:
Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
   'your code
End If

Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then
   'your other code
End If
Application.EnableEvents = True
End Sub
Here is the code with your recommendations. I still cannot get it to work. Thanks for the fast response
VBA Code:
Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then

    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)

End If

Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then

    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)

End If
Application.EnableEvents = True
End Sub
 
Last edited by a moderator:
Upvote 0
Try it like
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

Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
    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

Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then
   
    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
Also please post your code inside the code tags, not after them How to Post Your VBA Code
 
Upvote 0
Try it like
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

Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
    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

Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then
  
    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
Also please post your code inside the code tags, not after them How to Post Your VBA Code
I am getting a Compile error:
Block if without End if
 
Upvote 0
Looks like you had deleted two of the end ifs, try
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

Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
    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
End If
Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then

    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
End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Looks like you had deleted two of the end ifs, try
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

Set isect = Intersect(Range("H4:H500"), Target)
' Exit if updated cells do not fall in H4:H500
If Not isect Is Nothing Then
    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
End If
Set isect = Intersect(Range("G4:G500"), Target)
' Exit if updated cells do not fall in G4:G500
If Not isect Is Nothing Then

    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
End If
Application.EnableEvents = True
End Sub
Thank You. Have a great day.
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

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