PrivateSub Worksheet_Change(ByVal Target As Range) ' Developed by Contextures Inc. ' www.contextures.com Dim rngDV As Range Dim oldVal AsString Dim newVal AsString If Target.Count > 1ThenGoTo exitHandler
OnErrorResumeNext Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation) OnErrorGoTo exitHandler
If rngDV IsNothingThenGoTo exitHandler
If Intersect(Target, rngDV) IsNothingThen 'do nothing Else Application.EnableEvents = False newVal = Target.Value Application.Undo oldVal = Target.Value Target.Value = newVal If Target.Column = 1Then If oldVal = ""Then 'do nothing Else If newVal = ""Then 'do nothing Else If InStr(1, oldVal, newVal) <> 0Then If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1) Else Target.Value = Replace(oldVal, newVal & ",", "") EndIf Else Target.Value = oldVal & "," & newVal ' NOTE: you can use a line break, ' instead of a comma ' Target.Value = oldVal _ ' & Chr(10) & newVal EndIf EndIf EndIf EndIf EndIf