I created a DV with multiple selection using Debra's code and made minor
modification. It worked before but now it does not work.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler

Dim rngDV As Range
Dim lRow As Long
Dim lCol As Long

lCol = Target.Column 'column with data validation cell

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
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Select Case Target.Column
Case 3
If Target.Offset(0, 1).Value = "" Then
lRow = Target.Row
Else
lRow = Cells(Rows.Count, lCol + 1).End(xlUp).Row + 1
End If
Cells(lRow, lCol + 1).Value = Target.Value
End Select

End If

exitHandler:
Application.EnableEvents = True

End Sub

Help
--
mmk

Increments selected choices from any DV cell into single cells down adjacent
column.

What do you want it to do?


Gord Dibben MS Excel MVP

On Mon, 14 Sep 2009 08:09:02 -0700, MKuria wrote:

I created a DV with multiple selection using Debra's code and made minor
modification. It worked before but now it does not work.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler

Dim rngDV As Range
Dim lRow As Long
Dim lCol As Long

lCol = Target.Column 'column with data validation cell

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
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Select Case Target.Column
Case 3
If Target.Offset(0, 1).Value = "" Then
lRow = Target.Row
Else
lRow = Cells(Rows.Count, lCol + 1).End(xlUp).Row + 1
End If
Cells(lRow, lCol + 1).Value = Target.Value
End Select

End If

exitHandler:
Application.EnableEvents = True

End Sub

Help