New Member
October 28, 2020
Update - fixed it using OR as described in another post!
____________
Hi all!
I’ve made some changes to Phil's code (https://www.myonlinetraininghu.....ation-list) to allow for multiple drop down lists to be used, each in a different column. I can easily add a second range, however when I try to add any more ranges I get a 450 error. Any help you can provide would be appreciated!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OldVal As String
Dim NewVal As String
' If more than 1 cell is being changed
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, ActiveSheet.Range("Range_Sectors_v1", "Range_Locations_v1")) Is Nothing Then
' Turn off events so our changes don't trigger this event again
Application.EnableEvents = False
NewVal = Target.Value
' If there's nothing to undo this will cause an error
On Error Resume Next
Application.Undo
On Error GoTo 0
OldVal = Target.Value
' If selection is already in the cell we want to remove it
If InStr(OldVal, NewVal) Then
'If there's a comma in the cell, there's more than one word in the cell
If InStr(OldVal, ",") Then
If InStr(OldVal, ", " & NewVal) Then
Target.Value = Replace(OldVal, ", " & NewVal, "")
Else
Target.Value = Replace(OldVal, NewVal & ", ", "")
End If
Else
' If we get to here the selection was the only thing in the cell
Target.Value = ""
End If
Else
If OldVal = "" Then
Target.Value = NewVal
Else
' Delete cell contents
If NewVal = "" Then
Target.Value = ""
Else
' This IF prevents the same value appearing in the cell multiple times
' If you are happy to have the same value multiple times remove this IF
If InStr(Target.Value, NewVal) = 0 Then
Target.Value = OldVal & ", " & NewVal
End If
End If
End If
End If
Application.EnableEvents = True
Else
Exit Sub
End If
End Sub
1 Guest(s)