Too stupid to combine VBA codes

Logan602041

New Member
Joined
Nov 28, 2019
Messages
8
Office Version
  1. 2019
Platform
  1. 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
 

Logan602041

New Member
Joined
Nov 28, 2019
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,959
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Nov 28, 2019
Messages
8
Office Version
  1. 2019
Platform
  1. Windows
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! (y)
 

Logan602041

New Member
Joined
Nov 28, 2019
Messages
8
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Feb 1, 2016
Messages
2,959
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,107
Messages
5,622,777
Members
415,927
Latest member
vedasinternational

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top