Create dropdown list and display different values from another worksheet

[Jane_Hogan]

Hi all,

I have created several dropdown lists on a worksheet which all need to display different values in order to provide input for a name generator cell (using the textjoin formula). I found a VBA code which let's me display different values in a dropdown list ; For example sheet1 shows a dropdown list in column B with the option water which displays as 'WA' and Thee as 'TH' and so on. I would like to apply the same to the dropdown lists in column C to E but I'm unable to solve 2 problems:
1) The VBA code only works with the active sheet (=Sheet1). What code should I use to reference the other sheet (=DropDownValues)? I prefer to keep the dropdown values on a separate sheet so it can be hidden.
2) Sheet1 has several dropdown lists (column B to E) which need to display different values coming from different tables/cells. I tried to use the same VBA code for the other dropdown values on the active sheet but it's not working and I'm seeing a compile error (see screenshots)). How can I apply similar VBA codes in one project/sheet?

Thank you for your help!

Private Sub Worksheet_Change(ByVal Target As Range)

ProductName = Target.Value

If Target.Column = 2 Then

ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("BUValue"), 2, False)

If Not IsError(ProductCode) Then

Target.Value = ProductCode

End If

End If

End Sub

Thank you for your help!

 

[Zot]

It is because you are using same event trigger for the same sheet more than once.

You can use something like
Select Case Target.Column
Case 2
<code here>
Case 3
,code here.

 

[Jane_Hogan]

Hi Zot,

Many thanks for the feedback. I'm still having problems applying this code in the right way. Could you advise if below code is correct or needs to be changed?

And would you also know the answer to my 1st question as well?

Thank you!

Private Sub Worksheet_Change(ByVal Target As Range)
    ProductName = Target.Value
    If Target.Column = 2 Then
        ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("BUValue"), 2, False)
        If Not IsError(ProductCode) Then
            Target.Value = ProductCode
        End If
    End If
    Select Case Target.Column
    Case 2
    ProductName = Target.Value
    If Target.Column = 3 Then
        ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("LCValue"), 2, False)
        If Not IsError(ProductCode) Then
            Target.Value = ProductCode
        End If
    End If
End Sub

 

[Akuini]

@Jane_Hogan

1. Can you show us the data validation formula?
2. What are the tables name in sheet DropDownValues?
3. Could you please upload a sample workbook (without sensitive data) to a file-sharing site like Dropbox.com or Google Drive, and then share the link here? Also, ensure that the link is accessible to anyone.

 

[Jane_Hogan]

Hi Akuina,

1) I had some issues with the XL2BB tool but now it works so please see below the data validation formulas
2) Table names in sheet DropDownValues:
- BU
- Channel
- Phase
- Language
I have the same tables on sheet1 but with different table names:
- BUValue
- ChannelValue
- PhaseValue
- LanguageValue
3) Dropbox link: Example.xlsm

Thank you!

Example.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1
2		Business Unit	Channel	Phase	Language	NAME
3		WA	Out of Home	Awareness	German	WA_Out of Home_Awareness_German		Business Unit	Value		Channel	Value		Phase	Value		Language	Value
4		TH	Social Media	Motivate	French	TH_Social Media_Motivate_French		Water	WA		Out of Home	OOH		Awareness	AWA		English	UK
5		CO	Search	Purchase	Dutch	CO_Search_Purchase_Dutch		Thee	TH		Social Media	SOC		Motivate	MOT		German	GE
6		SO	Online Video Ads	Convert	Danish	SO_Online Video Ads_Convert_Danish		Coffee	CO		Search	SEA		Purchase	PUR		French	FR
7		AL	Television	Awareness	Spanish	AL_Television_Awareness_Spanish		Sodas	SO		Online Video Ads	OLV		Convert	CON		Dutch	NL
8		WA	Out of Home	Awareness	Italian	WA_Out of Home_Awareness_Italian		Alcohol	AL		Television	TLV					Danish	DK
9		TH	Out of Home	Awareness	German	TH_Out of Home_Awareness_German											Spanish	SP
10		CO	Out of Home	Awareness	German	CO_Out of Home_Awareness_German											Polish	PO
11																	Italian	IT
12
Sheet1

Cell Formulas
Range	Formula
F3:F10	F3	=TEXTJOIN("_",TRUE,B3:E3)

Cells with Data Validation
Cell	Allow	Criteria
B3:B10	List	=DropDownValues!$B$3:$B$7
C3:C10	List	=DropDownValues!$E$3:$E$7
D3:D10	List	=DropDownValues!$H$3:$H$6
E3:E10	List	=DropDownValues!$K$3:$K$10

Example.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2		Business Unit	Value		Channel	Value		Phase	Value		Language	Value
3		Water	WA		Out of Home	OOH		Awareness	AWA		English	UK
4		Thee	TH		Social Media	SOC		Motivate	MOT		German	GE
5		Coffee	CO		Search	SEA		Purchase	PUR		French	FR
6		Sodas	SO		Online Video Ads	OLV		Convert	CON		Dutch	NL
7		Alcohol	AL		Television	TLV					Danish	DK
8											Spanish	SP
9											Polish	PO
10											Italian	IT
11
DropDownValues

Private Sub Worksheet_Change(ByVal Target As Range)
'Created By Excel 10 Tutorial
    ProductName = Target.Value
    If Target.Column = 2 Then
        ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("BUValue"), 2, False)
        If Not IsError(ProductCode) Then
            Target.Value = ProductCode
        End If
    End If
End Sub

 

[Zot]

Hi Zot,

Many thanks for the feedback. I'm still having problems applying this code in the right way. Could you advise if below code is correct or needs to be changed?

And would you also know the answer to my 1st question as well?

Thank you!

Private Sub Worksheet_Change(ByVal Target As Range)
    ProductName = Target.Value
    If Target.Column = 2 Then
        ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("BUValue"), 2, False)
        If Not IsError(ProductCode) Then
            Target.Value = ProductCode
        End If
    End If
    Select Case Target.Column
    Case 2
    ProductName = Target.Value
    If Target.Column = 3 Then
        ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("LCValue"), 2, False)
        If Not IsError(ProductCode) Then
            Target.Value = ProductCode
        End If
    End If
End Sub

I'm not able to test your example because I'm using older version of Excel with no TextJoin . So, I'm just guessing here. This is how you can implement one event trigger for more than one column

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Select Case Target.Column
        Case Is = 2
            ProductName = Target.Value
            ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("BUValue"), 2, False)
            If Not IsError(ProductCode) Then
                Target.Value = ProductCode
            End If
        Case Is = 3
            ProductName = Target.Value
            ProductCode = Application.VLookup(ProductName, ActiveSheet.Range("LCValue"), 2, False)
            If Not IsError(ProductCode) Then
                Target.Value = ProductCode
            End If
    End Select
End Sub

I see that you have yet to define LCValue, thus it will give error.

 

[Akuini]

The table names in sheet DropDownValues are actually Table1, Table2, ...etc.
Try this:

1. Remove tables in Sheet1.
2. Create four named ranges that refer to the first column of each table in the sheet 'DropDownValues.' Also, remove any unnecessary named ranges you have created.
3. Set the data validation formula to refer to the named ranges. Using this method, the data validation list becomes dynamic. For a better understanding, check out this article:
   excel-tables-as-source-for-data-validation-lists

Jane_Hogan - Example - #1.xlsm
	A	B	C	D	E	F
1
2		Business Unit	Channel	Phase	Language	NAME
3		CO	OLV	MOT	GE	CO_OLV_MOT_GE
4		TH	OOH	PUR	FR	TH_OOH_PUR_FR
5		AL	TLV			AL_TLV
Sheet1

Cell Formulas
Range	Formula
F3:F5	F3	=TEXTJOIN("_",TRUE,B3:E3)

Cells with Data Validation
Cell	Allow	Criteria
B3:B10	List	=BU
C3:C10	List	=Channel
D3:D10	List	=Phase
E3:E10	List	=Language

The code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("B:E")) Is Nothing Then  'if target is in col B:E
        Dim fm, c As Range
        On Error Resume Next
           Set c = Evaluate(Target.Validation.Formula1)     'get the range where the list is located
        On Error GoTo 0
       
        If Not c Is Nothing Then
                fm = Application.Match(Target, c, 0)        'find selected item on the list
                Application.EnableEvents = False
                Target = c.Cells(fm).Offset(, 1)            'replace selected item with coresponding item in the next column
                Application.EnableEvents = True
        End If
    End If
End Sub

Note:
If the data validation are in a fixed range, say B3:E10, then you can change:
If Not Intersect(Target, Range("B:E")) Is Nothing Then
to:
If Not Intersect(Target, Range("B3:E10")) Is Nothing Then
The workbook:
Jane_Hogan - Example - #1

 

[Akuini]

Sorry, the code in post #7 is flawed; it will produce an error if you try to delete value in the cell with data validation.
Replace it with this one:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("B:E")) Is Nothing Then  'if target is in col B:E
        Dim fm, c As Range
        If Len(Target) > 0 Then
            On Error Resume Next
               Set c = Evaluate(Target.Validation.Formula1)     'get the range where the list is located
            On Error GoTo 0
           
            If Not c Is Nothing Then
                    fm = Application.Match(Target, c, 0)        'find selected item on the list
                    Application.EnableEvents = False
                    Target = c.Cells(fm).Offset(, 1)            'replace selected item with coresponding item in the next column
                    Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Jane_Hogan - Example - #2.xlsm

 

[Jane_Hogan]

Hi Akuini,

Fantastic and you are a lifesaver! It worked but now I realised one additional issue. I would like to add additional dropdown columns where the value does not have to change and remains the same when selected. With your code, the value shows up as a blank cell value now instead. Is there a way to solve this as well?

I have added the 2 rows (see column D = year and column F = season) in below document/link and added the respective tables on the dropdownvalue sheet. Could you have a look again and advise what needs to be changed to the code to make it work for all dropdown columns even if they do not change value upon selection.

Dropbox link

Many thanks again for your support!

 

[Akuini]

I would like to add additional dropdown columns where the value does not have to change and remains the same when selected.

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge > 1 Then Exit Sub
    If Not Intersect(Target, Range("B:C,E:E,G:G")) Is Nothing Then  'if target is in col B:E
        Dim fm, c As Range
        If Len(Target) > 0 Then
            On Error Resume Next
               Set c = Evaluate(Target.Validation.Formula1)     'get the range where the list is located
            On Error GoTo 0
            
            If Not c Is Nothing Then
                    fm = Application.Match(Target, c, 0)        'find selected item on the list
                    Application.EnableEvents = False
                    Target = c.Cells(fm).Offset(, 1)            'replace selected item with coresponding item in the next column
                    Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Col D & F keep their original value

Jane_Hogan - Example - #2 with column D & F update.xlsm
	B	C	D	E	F	G	H
2	Business Unit	Channel	Year	Phase	Season	Language	NAME
3	SO	OLV	2025	MOT	High	GE	SO_OLV_2025_MOT_High_GE
4	WA	OOH	2026	PUR	Low	FR	WA_OOH_2026_PUR_Low_FR
5	AL	TLV	2024	PUR	Mid	DK	AL_TLV_2024_PUR_Mid_DK
Sheet1

Cell Formulas
Range	Formula
H3:H5	H3	=TEXTJOIN("_",TRUE,B3:G3)

Cells with Data Validation
Cell	Allow	Criteria
B3:B10	List	=BU
C3:C10	List	=Channel
D3:D10	List	=Year
E3:E10	List	=Phase
F3:F10	List	=Season
G3:G10	List	=Language