PDA

View Full Version : Solved: Data Validation: Combine Two Cells In Drop Down Only



NFLnut
07-02-2011, 09:43 PM
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
07-03-2011, 02:24 AM
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.

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

NFLnut
07-03-2011, 11:46 AM
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
07-03-2011, 02:43 PM
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
With ThisWorkbook.Sheets("Lookups").Range("B:B"): Rem adjust
Set sourceRange = Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With

NFLnut
07-03-2011, 10:29 PM
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

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

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)" ):

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

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

mikerickson
07-03-2011, 11:08 PM
could you attach your workbook (with a small, but representative, dummy data set)?

NFLnut
07-04-2011, 09:46 PM
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
07-04-2011, 10:11 PM
Try
With ThisWorkbook.Sheets("Lookups").Range("B:B"): Rem adjust
Set sourceRange = .Parent.Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, 2))
End With

mikerickson
07-05-2011, 06:57 AM
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)

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

NFLnut
07-05-2011, 08:19 AM
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
07-05-2011, 10:14 AM
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
07-05-2011, 10:39 AM
Try moving the On Error Goto ErrorOut to immediatly before the If .Validation.Formula1 statemtment.

NFLnut
07-05-2011, 03:20 PM
That worked. Thanks again!

I owe you some beers! :giggle

NFLnut
07-05-2011, 06:54 PM
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
07-06-2011, 07:01 AM
Delete the entire SelectionChange event.

NFLnut
07-08-2011, 10:07 AM
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
07-08-2011, 06:05 PM
please attach the workbook.

NFLnut
07-08-2011, 06:58 PM
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! :eek: 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
07-08-2011, 10:24 PM
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
07-09-2011, 01:52 PM
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:

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
gets changed to:

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
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.

NFLnut
07-10-2011, 12:16 PM
Here is the current VBA code that I have set up for this worksheet:

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

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

Adding the second set of code instructions starting at:

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

breaks it. When I try to compile, I get "Ambiguous Name Detected: Worksheet_Change."

So, obviously I need to combine any future code instructions to the previous, but I don't know how.

Bob Phillips
07-10-2011, 12:49 PM
Untested, but this should be all that you need



Option Explicit

Const columnSep As String = " -- "
Const triggerPhrase As String = "=CodeDescrip"
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)
ElseIf .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

NFLnut
07-10-2011, 01:01 PM
Thanks!

I copied that over the previous code (mess :giggle ) but I got "Ambiguous Name Detected: triggerPhrase".

Bob Phillips
07-10-2011, 01:06 PM
Oops, didn't spot that



Option Explicit

Const columnSep As String = " -- "
Const triggerPhrase1 As String = "=CodeDescrip"
Const triggerPhrase2 As String = "=DiagDescrip"

Private Sub Worksheet_Change(ByVal Target As Range)
With Target

If .Cells.Count = 1 Then

If .Validation.Formula1 = triggerPhrase1 Then

On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)
ElseIf .Validation.Formula1 = triggerPhrase2 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
strExplicitXXXXList = Join(arrayOfStrings, ",")
End Function

NFLnut
07-10-2011, 01:55 PM
That is awesome! Worked perfectly. Thanks!

Just a question so my brain of mush that still doesn't quite grasp VB can understand ..

Why is it that I don't have to add a reference to column "O" (where the range named "DiagDescrip" resides) of the data on the "Lookups" worksheet in this section (it only references column "I" on the "Lookups" worksheet where the "CodeDescrip" range resides)?

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
As I said before .. I will need to add additional drop down validation boxes referencing other data on the "Lookups" worksheet in other columns on my main worksheet ("Daysheet"), so I just need to know so I don't have to keep asking this same question over and over (I hate to waste forum members time just because I don't yet fully understand ..)

Thanks again!

Bob Phillips
07-10-2011, 01:59 PM
They are just loop counters, so they have no significance in what you call them. ThisIsMyLoopIndex would be just as effective.

NFLnut
07-10-2011, 03:15 PM
Awesome!

I just added another column on the main sheet using different data validation and it also is working properly. I'm going to mark this thread SOLVED and hope it might help someone else. This makes a worksheet that my staff can use quick and easily without having to make the columns so huge, confusing, and unwieldy and eliminates the need to scroll endlessly.

VBA was all hieroglyphics to me a few days ago. 'Still is somewhat, but for a non-programmer type such as I, it seems like I have a little better understanding of how it works. I have a LONG way to go yet, but I learned something.

Thanks again, to you and Mike!

NFLnut
07-11-2011, 10:20 PM
I am having an additional problem cropping up whenever I change anything on the main worksheet. Specifically, it is an "Run-time error '1004': Application-defined or object-defined error." When I click "Debug" it references this line:

If .Validation.Formula1 = triggerPhrase1 Then

I know that this means that I need to define something (I guess it's because of the Option Explicit command?), but I'm not sure which or how.

Bob Phillips
07-12-2011, 12:14 AM
Post the offending workbook.

NFLnut
07-12-2011, 04:11 PM
Here is a sample of the beast. The actual workbook that I am working on contains proprietary data that I'd rather not post on the intertoobz. The sample is identical minus the sensitive data.

To get an idea of the type of op that results in the "Run-time error '1004':", try entering anything in cell AE9. Even entering a zero in that or other cells results in the error. I can't figure out what to do to get it to stop. I even tried to delete "Option Explicit" but that didn't help either.

Thanks again.

Bob Phillips
07-12-2011, 10:17 PM
Try this



Private Sub Worksheet_Change(ByVal Target As Range)
With Target

If .Cells.Count = 1 Then

If Not IsError(Application.Match(.Column, Array(7, 8, 9, 10, 11, 12, 24, 25, 26), 0)) And .Row > 1 Then
If .Validation.Formula1 = triggerPhrase1 Then

On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)

ElseIf .Validation.Formula1 = triggerPhrase2 Then

On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)

ElseIf .Validation.Formula1 = triggerPhrase3 Then

On Error GoTo ErrorOut
Application.EnableEvents = False
.Value = Split(CStr(.Value), columnSep)(0)

End If
End If
End If
End With
ErrorOut:
Application.EnableEvents = True
End Sub

NFLnut
07-13-2011, 08:43 AM
That seems to have taken care of the errors. Thanks again!