PDA

View Full Version : Solved: Restrict mulilpe entries is N/A or No error is selcted



khalid79m
09-08-2009, 04:19 AM
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
This code needs tweaking, not written by me, it currently lets you put multiple entries in a cell.
If however n/a or no_error is selected in the cell then disable multiple entreies for that cell only.
Can anyone help

mdmackillop
09-09-2009, 01:18 AM
If however n/a or no_error is selected in the cell
What does this mean? Please take the time to explain your question clearly, if you want us to spend time answering. I'm disinclined to try to interpret this code to see what it is meant to be doing.

Bob Phillips
09-09-2009, 03:25 AM
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(12), 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
ElseIf Target.Value = "N/A" Or Target.Value = "No_Error" Then

Target.Value = newVal
Else

Target.Value = oldVal & ", " & newVal
Target.Columns.AutoFit
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End If
End Sub