Pick multiple items from list box

[Alex]

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

 

[Joel]

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]

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]

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]

Nope - users can only pick one choice.

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

 

[Joel]

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.