Solved: Data Validation , multiple selection same cell

[khalid79m]

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 = 3 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

I have found this code, I dont understand it.

In named range "Comp1" I want a drop down list. The list is a named range "ListComp1" I can do this, what I cant do is get the list to allow multiple selction withing the same cell.

Can anyone help me, or break the code so I can understand it better,

[p45cal]

I doubt you'll ever get Data Validation to accept multiple selections!
What the code does is to tag further slections from the same dropdown in the same cell to the end of the contents of that cell, separated by commas.
Adjusted for your named range:[vba]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 = Range("ListComp1")
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 = 3 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Target.Value = oldVal 'optional line depending on what you want to happen if Delete is pressed or an empty string is chosen
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
[/vba]I've commented a new line 'optional line...' which you can lose if you want.

[khalid79m]

 
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 = 16 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

Hi I have managed to tweek the code, this now looks at column 16 and any cells with validation in them allow the multiple selctions to be added in the same cell.

How do I now get it to do this for column 16 , 21 33 and 44 and 47 ?

any help

[p45cal]

Either[vba]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 = Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Union(Columns(16), Columns(21), Columns(33), Columns(44), Columns(47)))
'rngDV.Select
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 oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Target.Value = oldVal 'optional line depending on what you want to happen if Delete is pressed or an empty string is chosen
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
[/vba]or:[vba]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)
'rngDV.Select
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
Select Case Target.Column
Case 16, 21, 33, 44, 47
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Target.Value = oldVal 'optional line depending on what you want to happen if Delete is pressed or an empty string is chosen
Else
Target.Value = oldVal & ", " & newVal
End If
End If
End Select
End If
exitHandler:
Application.EnableEvents = True
End Sub[/vba]

[khalid79m]

Thank you very much p45cal.

[khalid79m]

Can you explain what each line of the code is ?

[khalid79m]

also rather than selecting columns can I select named ranges ie

Select Case Target.Column
Case 16, 21, 33, 44, 47


Column 16 is named range "ABBS"
Column 21 is named range "Staff"
Column 33 is named rnage "Number"

and so on..

[p45cal]

You do keep moving the goalposts..
You can't use range names easily in a Select Case statement. But using the first alternative given in my earlier post, change[vba]Set rngDV = Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Union(Columns(16), Columns(21), Columns(33), Columns(44), Columns(47)))
[/vba]to:
[vba]Set rngDV = Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Range("ABBS", "Staff", "Number"))[/vba]Re:"Can you explain what each line of the code is ?" - I'd rather not, you have the code and the Help files, put the cursor in a word such as 'Union' in the code and press F1. Someone else here might be willing to explain though.

[mdmackillop]

I'd rather not, you have the code and the Help files, put the cursor in a word such as 'Union' in the code and press F1.

Also step through the code and use the Watch window to see how values are changing. Add your own comments. You'll understand more and learn much better that way.

[khalid79m]

mdmackillop & p45cal thanks for all your help, this all went down well. thanks

[khalid79m]

I require some more help . i need the columns to autofit as and when the change occurs

my code is

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A3") <> "" Then
    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 = Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Union(Columns(47), Columns(48), Columns(53), Columns(54), Columns(59), Columns(60), Columns(65), Columns(66), Columns(70), Columns(71)))
     'rngDV.Select
    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 oldVal = "" Then
             'do nothing
        Else
            If newVal = "" Then
                 'do nothing
                Target.Value = "" 'optional line depending on what you want to happen if Delete is pressed or an empty string is chosen
            Else
                Target.Value = oldVal & ", " & newVal
            End If
        End If
    End If
exitHandler:
    Application.EnableEvents = True
End If
End Sub

[khalid79m]

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A3") <> "" Then
    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 = Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Union(Columns(47), Columns(48), Columns(53), Columns(54), Columns(59), Columns(60), Columns(65), Columns(66), Columns(70), Columns(71)))
     'rngDV.Select
    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 oldVal = "" Then
             'do nothing
        Else
            If newVal = "" Then
                 'do nothing
                Target.Value = "" 'optional line depending on what you want to happen if Delete is pressed or an empty string is chosen
            Else
                Target.Value = oldVal & ", " & newVal
                Target.Columns.AutoFit
            End If
        End If
    End If
exitHandler:
    Application.EnableEvents = True
End If
End Sub

[khalid79m]

Is it possible that on Worksheet_Change(ByVal Target As Range) to have more than 1 target, my code at the momemnt looks at certain columns & allows multiple inputs, sperate to this I wasnt other columns say colum 1 ,10, 20 to autofit when the value in those columns changes can this be done aswell ?

[mdmackillop]

Check the column number and call the approprate sub routine
[VBA]
Private Sub Worksheet_Change(ByVal Target As Range)
Select case target.column
Case 1
Call DoCol1
Case 10
Call DoCol10
case else
'Do nothing
end select
end sub
[/VBA]

[p45cal]

Two points.
1. regarding your penultimate post the line
Target.Columns.AutoFit
will only autofit the column to match the width of the cell(s) in Target, not the whole column. If that's what you want fine, but I suspect not, so try
Columns(Target.Column).AutoFit
instead.

2. Put this block of code in the procedure where you want it to act (eg. just before the error handler, or inside the If Range("A3") <> "" Then block - or not)[vba]Select Case Target.Column
Case 1, 10, 20: Columns(Target.Column).AutoFit
End Select[/vba]

[khalid79m]

maybe i explained wrong or my understanding of your answer is a little blurred..

My aim is to have certain columns allow multiple selections using the "," to split them in the same cells. This is something I have below

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A3") <> "" Then
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 = Intersect(Cells.SpecialCells(xlCellTypeAllValidation), Union(Columns(47), Columns(48), Columns(53), Columns(54), Columns(59), Columns(60), Columns(65), Columns(66), Columns(70), Columns(71)))
'rngDV.Select
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 oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Target.Value = "" 'optional line depending on what you want to happen if Delete is pressed or an empty string is chosen
Else
Target.Value = oldVal & ", " & newVal
Target.Columns.AutoFit
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End If
End Sub

What I want to do now aswell as above is say that if columns number 30 is changed then delete 2 cells to the right and 5 cells to the left within the same row, for example

COLUMNS 30 ROW 6 , THE VALUE CHANGES , THEN COLUMNS 31 & 32 ROW 6 CLEAR CONTENTS, THEN COLUMNS 25:29 ROW 6 CLEAR CONTENTS.

I hope this makes sense..

[khalid79m]

Thanks for all your help.