Data Validation List based on Cell Value

aliikhlaq2006

New Member
Joined
Apr 4, 2012
Messages
44
I have a table in which currency in A and values in B
CAD2
USD13
AUD15
CAD5
CAD11

<tbody>
</tbody>
I enter text CAD in C1 and make data validation list in D1. Based on text in C1 data validation only shows the value against CAD. like image attached.

Data-Valid.png
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
This macro assumes that you have headers in row 1 starting in column A and your data starts in row 2. Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter a value in column C and press the RETURN key.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    Dim rngData As Range, strThisItem As String, strUnqItms As String, strTempAry() As String, itm As Variant, UniqueVals As String, bottomB As Long
    bottomB = Range("B" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With Cells(1).CurrentRegion
        .AutoFilter Field:=1, Criteria1:=Target
        For Each rngData In Range("B2:B" & bottomB).SpecialCells(xlCellTypeVisible)
            If rngData = "" Then Exit For
            strThisItem = rngData
            If InStr(strUnqItms, strThisItem) = 0 Then
                strUnqItms = strUnqItms & "," & strThisItem
            End If
        Next rngData
    End With
    strTempAry = Split(strUnqItms, ",")
    For Each itm In strTempAry
        If itm <> "" Then
            If itm = "" Then UniqueVals = itm Else UniqueVals = itm & "," & UniqueVals
        End If
    Next itm
    With Target.Offset(, 1).Validation
      .Delete
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=UniqueVals
    End With
    Range("A1").AutoFilter
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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
Back
Top