JohnBell79
New Member
- Joined
- Jul 19, 2023
- Messages
- 7
- Office Version
- 365
- Platform
- Windows
Hi,
I have managed to write a code to allow multiple selections in a cell from a drop down list. However It only works for 1 cell and not all the cells in that column. Whenever I try to apply a range to the code it stops working. Any tips appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim old_val As String
Dim new_val As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C$2" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
new_val = Target.Value
Application.Undo
old_val = Target.Value
If old_val = "" Then
Target.Value = new_val
Else
If InStr(1, old_val, new_val) = 0 Then
Target.Value = old_val & vbNewLine & new_val
Else:
Target.Value = old_val
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Thanks
I have managed to write a code to allow multiple selections in a cell from a drop down list. However It only works for 1 cell and not all the cells in that column. Whenever I try to apply a range to the code it stops working. Any tips appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim old_val As String
Dim new_val As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C$2" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
new_val = Target.Value
Application.Undo
old_val = Target.Value
If old_val = "" Then
Target.Value = new_val
Else
If InStr(1, old_val, new_val) = 0 Then
Target.Value = old_val & vbNewLine & new_val
Else:
Target.Value = old_val
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Thanks