Data Validation List based on Cell Value

[aliikhlaq2006]

I have a table in which currency in A and values in B[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]CAD[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]USD[/TD]
[TD]13[/TD]
[/TR]
[TR]
[TD]AUD[/TD]
[TD]15[/TD]
[/TR]
[TR]
[TD]CAD[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]CAD[/TD]
[TD]11[/TD]
[/TR]
</tbody>[/TABLE]
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.

 

[mumps]

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.

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