Logan602041
New Member
- Joined
- Nov 28, 2019
- Messages
- 8
- Office Version
- 2019
- Platform
- Windows
Gentlemen, I'm new to Excel, VBA codes and far too stupid to get my head around the task I have set myself and have come here to ask for your help as I have already thrown way too much time at this problem to no avail.
Problem: I am trying to make a 'risk assessment spreadsheet' and I need two different types of drop-down menu on the same sheet, I need to identify an illness from a drop down menu and as I make selections have them appear in cells to the right of my drop down menu. For example: Stupid, Lazy, VBA unteachable, Block-headed, Bumbling idiot.
I've managed this by copying the VBA code below from this link: Excel Data Validation - Select Multiple Items
This works fine with the selected "illness" spread in individual cells to the right. Great (code below)
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler
Dim rngDV As Range
Dim iCol As Integer
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
If Target.Column = 3 Then
If Target.Value = "" Then GoTo exitHandler
If Target.Validation.Value = True Then
iCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1
Cells(Target.Row, iCol).Value = Target.Value
Else
MsgBox "Invalid entry"
Target.Activate
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
But, I want the second type of multiple selection drop-down (Illness solutions) to simply list my selected multiple "solutions" in a single cell separated by commas. For example: Underneath "VBA Unteachable" I'd like to have options for say.... "Jump off a bridge, Beat head against wall, Go to a forum for help, Give up" all displayed in that one cell.
Whilst I have found the code to do this (see below) I cannot find a way to combine them both and then limit this second type of multiple drop-down selection to a only bunch of different cells on this same sheet, I'd be most grateful if anyone has a solution, thanks!
Code:
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
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 Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler
lType = Target.Validation.Type
If lType = 3 Then
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
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
Debug.Print strVal
Debug.Print CStr(Ar(i))
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
Target.Value = Left(strVal, Len(strVal) - 2)
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Problem: I am trying to make a 'risk assessment spreadsheet' and I need two different types of drop-down menu on the same sheet, I need to identify an illness from a drop down menu and as I make selections have them appear in cells to the right of my drop down menu. For example: Stupid, Lazy, VBA unteachable, Block-headed, Bumbling idiot.
I've managed this by copying the VBA code below from this link: Excel Data Validation - Select Multiple Items
This works fine with the selected "illness" spread in individual cells to the right. Great (code below)
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exitHandler
Dim rngDV As Range
Dim iCol As Integer
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
If Target.Column = 3 Then
If Target.Value = "" Then GoTo exitHandler
If Target.Validation.Value = True Then
iCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1
Cells(Target.Row, iCol).Value = Target.Value
Else
MsgBox "Invalid entry"
Target.Activate
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
But, I want the second type of multiple selection drop-down (Illness solutions) to simply list my selected multiple "solutions" in a single cell separated by commas. For example: Underneath "VBA Unteachable" I'd like to have options for say.... "Jump off a bridge, Beat head against wall, Go to a forum for help, Give up" all displayed in that one cell.
Whilst I have found the code to do this (see below) I cannot find a way to combine them both and then limit this second type of multiple drop-down selection to a only bunch of different cells on this same sheet, I'd be most grateful if anyone has a solution, thanks!
Code:
Option Explicit
' Developed by Contextures Inc.
' www.contextures.com
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 Ar As Variant
On Error Resume Next
Dim lType As Long
If Target.Count > 1 Then GoTo exitHandler
lType = Target.Validation.Type
If lType = 3 Then
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
On Error Resume Next
Ar = Split(oldVal, ", ")
strVal = ""
For i = LBound(Ar) To UBound(Ar)
Debug.Print strVal
Debug.Print CStr(Ar(i))
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
Target.Value = Left(strVal, Len(strVal) - 2)
Else
Target.Value = strVal & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub