Multiple selection on dropdown in same cell
 

Dear Users

I am trying to make multiple selection of drop down values to appear in same cell

I am using VBA code

I want to do this for 2 seperate columns

When i run the code , it works perfectly for one column but not the other columns
i think the issues is with the Range

Please see source code



Column 8 : Room used works fine
Column 11: Audience type does not seem to work.

Can you please help

Multiple selection on dropdown in same cell
 

Try this in the code behind the worksheet...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Column = 8 Then sub1_Change Target
If Target.Column = 11 Then sub2_Change Target
End If 'Target.Count = 1
End Sub


Private Sub sub1_Change(Target As Range)
' Description of what this does goes here...

Dim sOldVal$, sNewVal, lCode&
Dim rngDV As Range, rngList As Range, rngListID As Range

With ActiveSheet
Set rngList = .Range("external")
Set rngListID = .Range("externalID")
End With 'ActiveSheet

'On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then Exit Sub

On Error GoTo exitHandler
If Not Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
With Target
sNewVal = .Value: Application.Undo
sOldVal = .Value: .Value = sNewVal
If sNewVal = "" Then .Offset(0, 1).ClearContents
End With 'Target
With rngListID.Range("A1")
If Not oldVal = "" Then
lCode = .Offset(WorksheetFunction.Match(Target.Value, rngList,
0) - 1, 0)
Target.Offset(0, 1).Value = lCode
Else
lCode = .Offset(WorksheetFunction.Match(Target.Value, rngList,
0) - 1, 0)
Target.Value = sOldVal & ", " & sNewVal
Target.Offset(0, 1).Value = Target.Offset(0, 1).Value & ", " &
lCode
End If 'Not oldVal = ""
End With 'rngListID.Range("A1")
End If 'Not Intersect(Target, rngDV) Is Nothing

exitHandler:
Application.EnableEvents = True
End Sub

Private Sub sub2_Change(Target As Range)
' Description of what this does goes here...

Dim rngDV As Range, sOldVal$, sNewVal$

Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then Exit Sub

If Not Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
With Target
sNewVal = .Value: Application.Undo
sOldVal = .Value: .Value = sNewVal
If sOldVal < "" Or sNewVal < "" Then _
.Value = oldVal & ", " & newVal
End With 'Target
End If 'Not Intersect(Target, rngDV) Is Nothing

exitHandler:
Application.EnableEvents = True
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion