Too stupid to combine VBA codes

[Logan602041]

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

 

[Logan602041]

That my friend is perfect thank you very very much!

I will dive into this in the morning and see if I can fathom from your code how you made this work.

Once again I am most grateful.... Thank you for your kindness.

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.
Actually I don't fully understand the code from Contexture, so you need to test it in various ways to see how it works.
Here's my understanding:
The original code from Contexture doesn't define the range where the data validation is located, so it could be anywhere.
What my code does is define the range i.e B6 for the first type data validation and C7:J13 for the second type.

 

[Logan602041]

It is done, Akuini you are a star thank you once again I was aware that the Contexture code applied to the entire document and your solution is exactly what I needed.

Faith in humanity restored, seems like a bit of a bloody oversight from MS and Excel not to have these things as standard in their software.

All the best mate!

 

[Akuini]

Great, good luck with your project.

 

[Logan602041]

Akuini, if you're still there I wonder if I might again avail myself of your expertise.....I really thought I had got to grips with your code and what it was doing but I have moved onto a second Workbook now using the same code and hit a small problem.

I just want Row 7 to do what row 6 was doing (ie, populating columns to the right from a multiple entry dropdown menu) however I cannot get the code to duplicate what is going on in row 6 for row 7.

I thought it might be as simple as changing the "B6" to "B6:B7" but it doesn't work and stops the B6 cell from doing its business.

I'm sure this is a simple syntax thing that I'm just not getting, might you be able to help once again?

'range where first data validation type is located
If Target.Address(0, 0) = "B6" And Target.Value <> "" Then
iCol = Cells(Target.Row, Columns.Count).End(xlToLeft).Column + 1
If iCol > xcol Then MsgBox "No more column available": GoTo exitHandler
Cells(Target.Row, iCol).Value = Target.Value

Cheers

 

[Akuini]

Ok, just change this line:
If Target.Address(0, 0) = "B6" And Target.Value <> "" Then
to this:
If Not Intersect(Target, Range("B6:B7")) Is Nothing And Target.Value <> "" Then

 

[Logan602041]

Thank you Saviour!

Perfect, much gratitude once again!

 

[Akuini]

You're welcome.