Pick multiple items from list box
The code will immediately run after any one of the cells are selected. The
code can be written to wait until multiple columns are selected (2 or 3).
You can't have a choice of 1, 2 or 3 items selected.
"Alex" wrote:
Nope - users can only pick one choice.
"Joel" wrote:
See if this works. I removed some statements that may of caused problems.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim cell As Range
For Each cell In Target
Application.EnableEvents = False
On Error GoTo exitHandler
newVal = cell.Value
Application.Undo
oldVal = cell.Value
cell.Value = newVal
If cell.Column = 6 Or 21 Or 22 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
cell.Value = oldVal _
& ";# " & newVal
End If
End If
End If
End If
Next cell
exitHandler:
Application.EnableEvents = True
End Sub
"Alex" wrote:
I was getting an error that cell was not defined so I Dim Cell As Range. Now
the code just let's users pick one choice. Should I Dim Cell as something
else?
"Joel" wrote:
see if this code helps
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
For Each cell In Target
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(cell, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = cell.Value
Application.Undo
oldVal = cell.Value
cell.Value = newVal
If cell.Column = 6 Or 21 Or 22 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
cell.Value = oldVal _
& ";# " & newVal
End If
End If
End If
End If
Next cell
exitHandler:
Application.EnableEvents = True
End Sub
"Alex" wrote:
I have list boxes in several columns in my worksheet. I want users to be
allowed to pick multiple choices from the list boxes in columns 6, 20 & 21.
The code below is allowing users to pick multiple choices from ALL the list
boxes. Can I modify this code to only allow it in columns 6, 20 & 21?
Thanks.
Private Sub Worksheet_Change(ByVal Target As Range)
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 Target.Column = 6 Or 21 Or 22 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
Target.Value = oldVal _
& ";# " & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
|