About Us

chevenowner

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

HTML Code:

 Private Sub Worksheet_Change(ByVal Target As Range)
   sub1_Change Target
   sub2_Change Target
End Sub


Private Sub sub1_Change(ByVal Target As Range)

Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lCode As Long
Dim wsList As Worksheet
Dim rngList As Range
Dim rngListID As Range
If Target.Count  1 Then GoTo exitHandler

Set wsList = ActiveSheet
Set rngList = wsList.Range("external")
Set rngListID = wsList.Range("externalID")

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 = 8 Then
    If oldVal = "" Then
      'do nothing
         lCode = rngListID.Range("A1") _
            .Offset(Application. _
                WorksheetFunction _
                .Match(Target.Value, _
                rngList, 0) - 1, 0)
         Target.Offset(0, 1).Value = lCode
   
   Else
      If newVal = "" Then
        'do nothing
         Target.Offset(0, 1).ClearContents
      Else
         lCode = rngListID.Range("A1") _
            .Offset(Application. _
                WorksheetFunction _
                .Match(Target.Value, _
                rngList, 0) - 1, 0)
         Target.Value = oldVal _
           & ", " & newVal
         Target.Offset(0, 1).Value = Target.Offset(0, 1).Value _
           & ", " & lCode
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

Private Sub sub2_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 = 11 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]

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

Can you please help

GS[_2_]

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

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How do I allow a multiple selection from a dropdown?	Monica	Excel Discussion (Misc queries)	11	April 17th 08 04:34 PM
Dropdown in cell base on a selection of a different drop down	paapa21	Excel Programming	3	February 26th 08 11:52 PM
How do you lock a cell after making a selection from a dropdown b	GuyHUf	Excel Worksheet Functions	0	June 25th 07 04:06 PM
VLOOKUP or dropdown in the cell depending on selection in another	Spottydog	Excel Discussion (Misc queries)	1	January 31st 07 07:59 AM
Allow selection of multiple values in dropdown list in excel	Nancy @ CHR	Excel Discussion (Misc queries)	2	April 13th 06 10:44 PM

Menu

About Us