mykal66
12-05-2019, 01:57 AM
Hi
I have some code from that allows users to select multiple options from a drop down list in a specific column, in the code below it is columns 4. Does anyone know how to amend this so it applied to columns 4 & 5 please?
Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim lMax As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler
lType = Target.Validation.Type
lMax = 5
If lType = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 4 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
If newVal = CStr(Ar(i)) Then
'do not include this item
strVal = strVal
lCount = 1
Else
strVal = strVal & CStr(Ar(i)) & ", "
End If
Next i
If lCount > 0 Then 'newVal not included
Target.Value = Left(strVal, Len(strVal) - 2)
Else
'if cell contains item limit
' show message and restore old value
If i >= lMax Then
Target.Value = oldVal
MsgBox "Too many items -- limit is " & lMax
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
I have some code from that allows users to select multiple options from a drop down list in a specific column, in the code below it is columns 4. Does anyone know how to amend this so it applied to columns 4 & 5 please?
Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim strVal As String
Dim i As Long
Dim lCount As Long
Dim lMax As Long
Dim Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler
lType = Target.Validation.Type
lMax = 5
If lType = 3 Then
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 4 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
If newVal = CStr(Ar(i)) Then
'do not include this item
strVal = strVal
lCount = 1
Else
strVal = strVal & CStr(Ar(i)) & ", "
End If
Next i
If lCount > 0 Then 'newVal not included
Target.Value = Left(strVal, Len(strVal) - 2)
Else
'if cell contains item limit
' show message and restore old value
If i >= lMax Then
Target.Value = oldVal
MsgBox "Too many items -- limit is " & lMax
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub