I have 2 worksheet change events that happen on my worksheet.
One first - looks for duplicate choices and prevent the user form using them in column B
Second one - allows the user to combine multiple choices from a data list and separate them by "/"
The two code are separated by '********************* for your to distinguish them apart
Earlier they were both working but now when I choose the drop down and then go to add another multiple choice it does not combine the two it just has either one or the other. How to best get them working together.
The reason why I want to add this is I have 37 Different Independent choices in one Drop down and you could have any combination of 2,3,4,5 services running at any given time. There is no way to account for all the different combinations to have that be an choice already. I saw using Multiple choice with data validation but it did not show how to get 2 change events working together.
Any help would be great.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
' this prevents the user from using a duplicate dropdown choice on the Daily Chgs Tab
Dim Match As Range
Dim Rng As Range
Dim RngBeg As Range
Dim RngEnd As Range
Dim x As String
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' eliminates multiple cell selection, which would be typical if a whole row, or whole column, or a block of cells were selected for deletion
If Target.Cells.Count > 1 Then Exit Sub
' ignores changes where the content of the target cell has been deleted
If Target.Value = "" Then Exit Sub
Set RngBeg = Range("B11")
Set RngEnd = Range("A:K").Find("TOTALS", , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
Set Rng = Range(RngBeg, Cells(RngEnd.Row - 1, RngBeg.Column)).Resize(ColumnSize:=5)
Set Match = Rng.Find(Target.Value, , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
If Not Match Is Nothing Then
x = Match.Address
Set Match = Rng.FindNext(Match)
If Not Match Is Nothing Then
If Match.Address = x Then Exit Sub
Application.EnableEvents = False
Target.Value = Empty
Target.Select
MsgBox "Please make another selection. Duplicates are not allowed."
Application.EnableEvents = True
End If
End If
End If
'****************************************************************
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& "/" & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Bookmarks