RegularExcelUser
New Member
- Joined
- Apr 6, 2023
- Messages
- 25
- Office Version
- 365
- Platform
- Windows
I had used this piece of code I'd found on Youtube to allow me build a drop-down list where the user could select several options in a drop down list as opposed to just one. I had applied this to several different cells in my worksheet and it worked fine. However, it has now stopped working and I can't figure out why. I did originally have the Target.Address set as specific cell R1C1 references, but decided to name the cells as I have other script running on the same page that inserts rows based on clicking a command button, and another that hides rows based on selecting certain dropdown options. I thought it might be something to do with some of the other code, so I deleted those out entirely in a copy of my file to see if that would work. Unfortunately, that hasn't done the trick either. Appreciate it if someone could take a look and suggest why it might not be working, other changes I could make that might make it work or even a whole new code if you think there's a better way to do it.
VBA Code:
Private Sub Worksheet_Change3(ByVal Target As Range)
'Code by Sumit Bansal from https://trumpexcel.com
' To allow multiple selections in a Drop Down List in Excel (without repetition)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "Badges" Or Target.Address = "Placeholder_Badges" Or Target.Address = "Delivery_Days" Or Target.Address = "Select_By_Country" Or Target.Address = "Select_By_Region" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub