Solved: Data Validation: Combine Two Cells In Drop Down Only

[NFLnut]

I posted this at another forum but mostly got suggestions telling me to do this via non-VB methods. I need to do this project in the following manner for various reasons. Since the VB code that I d/l'd into my worksheet is "supposed" to work exactly as I want, I just need some help in tweaking it to work for my setup. I would appreciate any help anyone could give me.

I am a long time Excel user, and have enough of a grasp of creating formulas but I have to admit that I know next to nothing about VB. I found a thread which discussed what I wanted to do with Data Validation and I "applied" the Visual Basic code to the worksheet but it will not work. Here is what I am trying to do:

I have two columns that I want to appear combined in the drop down (data validation) list, but once the selection is made, I only want the first column to be entered into the cell. Column B is medical procedure codes (five digit numbers) and the second column (column C) is the description of the procedure code.

Example:

B2 = 50501

C2 = X-Ray

I2 = 50501 -- X-Ray

Staff will need to see the description (in C2, in a separate worksheet titled "Lookups") to make the proper proc code selection. When they select the item in the drop down -- using the example above they would see " 50501 -- X-Ray " the cell would then be populated with only " 50501 " . I created a third (non adjacent) column that combines the two ("Lookups!" worksheet, column I) which contains this formula: =B2 & " -- " &C2 . Rows 2-32 of each column contain the actual data, and row 1 of each column contains the title/description of the data below it. I named the actual data (procedure codes) in B2-32 "ProcCode," C2-32 "Description," and I2-32 "CodeDescrip" in the name field. The cells that I will eventually place this data validation/drop down on the main worksheet (which is titled "Daysheet") into is G9:J36 (but am just trying to get it working in G9 on the main worksheet titled "Daysheet" for now).

I downloaded this formula from another site: www dot contextures dot com/DataValNameID.zip (I am using MS Excel 2003/XP) which I adapted to the following and placed under "General" "Declarations" (it also appears under "Worksheet" "Change"):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errHandler
If Target.Cells.Count > 1 Then GoTo exitHandler
If Target.Column = 2 Then
If Target.Value = "" Then GoTo exitHandler
Application.EnableEvents = False
Target.Value = Worksheets("Lookups").Range("B1") _
.Offset(Application.WorksheetFunction _
.Match(Target.Value, Worksheets("Lookups").Range("CodeDescrip"), 0), 0)
End If

exitHandler:
Application.EnableEvents = True
Exit Sub

errHandler:
If Err.Number = 13 Or Err.Number = 1004 Then
GoTo exitHandler
Else
Resume Next
End If

End Sub

The columns that have the potential drop down data ("ProcCode" "Description" and "CodeDescrip") are in another worksheet entitled "Lookups". I have also tried to place "ProcCode" in place of where it says "B1."

In the cell that I want the validation (I actually have a range of cells that I will eventually put this validation into if I can get it working in one cell first) I have chosen "Data/Validation/List/" and in the source box I entered "=CodeDescrip". I have been trying to get this to work for several days with no luck. Either the VB code is not running or I have not made the proper changes to the code above. BTW -- I need to use validation versus a ComboBox because the codes will/may be replaced or added to, AND because so many cells on this sheet will contain this drop down menu that validation will make for a cleaner interface and be less confusing to the users (whom are slightly computer literate ;^) ). Also, because I know that there are ways that this "can" be done using validation and VB, I just need to figure out how to get it to work in this case.

I have also tried another method at other sites:

www dot mrexcel dot com/forum/showthread.php?t=50938 (post #4)

and
www dot pcreview.co.uk/forums/dat...-t2741440.html

with no luck. I am sure it is operator/programmer (ME!) error, but am wondering if some kind person could help a moron out! I actually have to adapt this throughout this Excel project so I need to figure this out. Whch opens one last question: How would I use the same VB formula in other cells (with other data from other columns) without screwing up THIS? I would love to know how to use VB and understand it better (and I will do that in the future), but for now I need to get this project done. Sorry for the length of this post but I just wanted to eliminate any unnecessary work for anyone who may be able to help.

[mikerickson]

You could put this in the Sheet's code module.

The way it is used is that if you want this dual validation list in a cell, set the validation of that cell so that the triggerPhrase ("Dual Validated Cell") is the Title of the Input Message.
(Note the input message does not need to be shown, nor does any text need to be entered for the input message, neither does any kind of validation need to be set, only the Title of the input message needs to be set.)

There is one drawback to this approach. If, instead of selecting from the list, the user types 50501, an error message will appear, since 50501 is not on the list "50501 - X-Ray" is.

[VBA]Option Explicit

Const columnSep As String = " - "
Const triggerPhrase As String = "Dual Validated Cell"

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count = 1 Then
If .Validation.InputTitle = triggerPhrase Then
On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)
End If
End If
End With
ErrorOut:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sourceRange As Range

With Sheet1.Columns(2): Rem adjust
Set sourceRange = Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With

With Target
If .Cells.Count = 1 Then
With .Validation
If .InputTitle = triggerPhrase Then
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween _
, Formula1:=strExplicitList(sourceRange)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = triggerPhrase
End If
End With
End If
End With
End Sub

Private Function strExplicitList(fromRange As Range)
Dim arrayOfStrings() As String
Dim i As Long
With fromRange
ReDim arrayOfStrings(1 To .Rows.Count)
For i = 1 To .Rows.Count
arrayOfStrings(i) = CStr(.Cells(i, 1)) & columnSep & CStr(.Cells(i, 2))
arrayOfStrings(i) = Replace(arrayOfStrings(i), ",", " ")
Next i
End With
strExplicitList = Join(arrayOfStrings, ",")
End Function[/VBA]

[NFLnut]

Thanks, Mike! I copied that into the worksheet entitled "Daysheet," but I'm not certain how to get it to reference the cells in the other worksheet entitled "Lookups." Since I'm a VB dummy, that might take me some time. I appreciate your help and your time!

[mikerickson]

This line in the Worksheet_SelectionChange event controls where the drop down gets its list. If the source is sheet Lookups columns B and C, this syntax should be used
[VBA]With ThisWorkbook.Sheets("Lookups").Range("B:B"): Rem adjust
Set sourceRange = Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With [/VBA]

[NFLnut]

This line in the Worksheet_SelectionChange event controls where the drop down gets its list. If the source is sheet Lookups columns B and C, this syntax should be used

[vba]With ThisWorkbook.Sheets("Lookups").Range("B:B"): Rem adjust
Set sourceRange = Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With [/vba]

I still can't get the data to change from the "50501 -- X-Ray" to the "50501" etc. It still enters the whole "50501 -- X-ray" into the cell.

Here is the way that I have data set up in the "Lookups" worksheet:

Col. B*****Col. C*****Col. I

50501*****X-Ray*****50501 -- X-Ray
51502*****Cat Scan***51502 -- Cat Scan

etc, in rows 2-34 (I added the asterisks only because the columns weren't lining up in this post).

In the cell (G9, actually) on the main worksheet ("Daysheet") I have set up Data Validation as List/"=CodeDescrip" (which is what I have named cells I2:I34 on the "Lookups" worksheet). Column B2:B34 on the "Lookups" worksheet I have named "ProcCode".

Using the info from your last post, do I still use the line (in the section "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" ):

[vba]With ThisWorkbook.Sheets("Lookups").Range("B:B"): Rem adjust
Set sourceRange = Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With [/vba] ??

Sorry for the continual questions. I'm doing something wrong, obviously.

[mikerickson]

could you attach your workbook (with a small, but representative, dummy data set)?

[NFLnut]

I've been away all day and into the late evening. Here is a sample of the workbook that I am working on. Hope this helps. The cells that I am trying to get this drop down/validation working on are in worksheet named "Daysheet" and column G. Eventually, I will also have some additional columns that I will need to do the same thing in with different data (codes with full description in the drop down but only entering the code into the cells). Specifically, column W.

And thanks again!

[mikerickson]

Try
[VBA]With ThisWorkbook.Sheets("Lookups").Range("B:B"): Rem adjust
Set sourceRange = .Parent.Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With [/VBA]

[mikerickson]

At a closer look, creating an explicit list with the SelectionChange event is making the workbook unstable. Plus, the current use of a range to cocatenate the validation source makes it unnessesary.
The attached has this in the sheet's code module. (note the changed constants)

[VBA]Option Explicit

Const columnSep As String = " -- "
Const triggerPhrase As String = "=CodeDescrip"

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count = 1 Then
If .Validation.Formula1 = triggerPhrase Then
On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)
End If
End If
End With
ErrorOut:
Application.EnableEvents = True
End Sub[/VBA]

[NFLnut]

That worked perfectly!

If I need to create a similar drop down for another set of data in other cells, do I adapt this and add it to the same "General" "Declarations" ?

Thanks so much for your help! I bought a book to try and learn VB for Excel, but I would have never figured this out on my own.

[NFLnut]

I am having one problem .. when I try to enter or change data in other cells on the "Daysheet" worksheet, I get "Run Time Error 1004." I tried changing the "On Error GoTo ErrorOut" to "On Error Resume Next" but then the code stops working properly.

[mikerickson]

Try moving the On Error Goto ErrorOut to immediatly before the If .Validation.Formula1 statemtment.

[NFLnut]

That worked. Thanks again!

I owe you some beers!

[NFLnut]

Sorry .. I do have one other issue -- I'm getting a "Compile error: Variable not defined" on the line: strExplicitList = Join(arrayOfStrings, ",")

I'm not sure what to add here (without mucking it up).

[mikerickson]

Delete the entire SelectionChange event.

[NFLnut]

I've been away at conference for a few days .. I'm not sure what was causing that error before, but it seems to be working without error now.

I have another range of cells that I am setting up similar data validation in, and will probably have one or two others. Specifically, I now have a column (O2:O94) which is named "DiagDescrip." I experimented with this formula trying to substitute "O" for all instances of "i" and changed "Const triggerphase As String = "=CodeDescrip" " to " .. String = "=DiagDescrip" " but it didn't work. In fact, it stopped the "=CodeDescrip" code from working as well.

What do I need to change in that code to make it work with another data set? And can I add that code to the existing code window?


EDIT: I should add that I arrived at O2:O94 the same way I did column I .. it is concatenating two columns as in I using the similar formula as in I (i.e.) =K3 & " -- " &M3

Column K consists of numerical "diagnosis codes" and column M is the description of each code.

[mikerickson]

please attach the workbook.

[NFLnut]

Here is the sample worksheet with the changes made since last time ..

I will have more columns with cells to do this with, but if I can see what you change for this additional set of data, I can probably (hopefully) figure out how to do it for those. The book I have on VBA for Excel doesn't even go into this type of op for me to learn. I guess I need a better book! As I said, I tried copying the code you provided, pasting it in and changing the "i"'s to "o"s and the "=CodeDescrip" to "=DiagDescrip" but no cigar.

[NFLnut]

Sorry .. I didn't tell you where the new data validation cells are. They are in the two columns titled "Diag Code" at K9:L36 on the sheet titled "Daysheet".

[NFLnut]

I created yet another sample worksheet and stripped out the data validation in the cells that you previously created for me for the data validation in "Daysheet" cells (in column G), using the data array "CodeDescrip" in column "I" from the "Lookups" daysheet. I then copied that code and changed all instances of "i" to "o" (referencing the appropriate columns on the "Lookups" worksheet) and changed the reference at the top of the code window from "=CodeDescrip" to "=DiagDescrip" and it worked.

That is:

[vba]Option Explicit

Const columnSep As String = " -- "
Const triggerPhrase As String = "=CodeDescrip"

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count = 1 Then
If .Validation.Formula1 = triggerPhrase Then
On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)
End If
End If
End With
ErrorOut:
Application.EnableEvents = True
End Sub


Private Function strExplicitXXXXList(fromRange As Range)
Dim arrayOfStrings() As String
Dim i As Long
With fromRange
ReDim arrayOfStrings(1 To .Rows.Count)
For i = 1 To .Rows.Count
arrayOfStrings(i) = CStr(.Cells(i, 1)) & columnSep & CStr(.Cells(i, 2))
arrayOfStrings(i) = Replace(arrayOfStrings(i), ",", " ")
Next i
End With
strExplicitList = Join(arrayOfStrings, ",")
End Function[/vba]
gets changed to:

[vba]Option Explicit

Const columnSep As String = " -- "
Const triggerPhrase As String = "=DiagDescrip"
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Cells.Count = 1 Then
If .Validation.Formula1 = triggerPhrase Then
On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)
End If
End If
End With
ErrorOut:
Application.EnableEvents = True
End Sub
Private Function strExplicitXXXXList(fromRange As Range)
Dim arrayOfStrings() As String
Dim o As Long
With fromRange
ReDim arrayOfStrings(1 To .Rows.Count)
For o = 1 To .Rows.Count
arrayOfStrings(o) = CStr(.Cells(o, 1)) & columnSep & CStr(.Cells(o, 2))
arrayOfStrings(o) = Replace(arrayOfStrings(o), ",", " ")
Next o
End With
strExplicitList = Join(arrayOfStrings, ",")
End Function[/vba]
and it works.

The problem I am having is figuring out how to have the "=CodeDescrip" *AND* the "=DiagDescrip" working at the same time. I can't figure out how to add the second validation code (and eventually a third, fourth, etc) without breaking the first.