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