Sub DropDown14_Change()
Dim ScCell As Range, key
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Set ws = Worksheets("Dashboard")
Set wsD = Worksheets("DATA")
Set complistDict = CreateObject("Scripting.Dictionary")
Dim DD14V As Variant



complistDict.RemoveAll
Dim DD14 As Object
Set complistDict = Nothing
Set complistDict = CreateObject("scripting.dictionary")

ws.Shapes("Drop Down 16").ControlFormat.RemoveAllItems

Set DD14 = ws.Shapes("Drop Down 14").OLEFormat.Object
Set DD16 = ws.Shapes("Drop Down 16").OLEFormat.Object
DD14V = DD14.List(DD14.Value)

'ws.dropdown14.Clear
 For Each ScCell In wsD.Range("E2", wsD.Cells(Rows.Count, "E").End(xlUp))
 Dic.CompareMode = vbTextCompare
If ScCell.Value = DD14V Then
If Not Dic.Exists(LCase(rCell.Offset(, -1).Value)) Then
Dic.Add LCase(rCell.Offset(, -1).Value), Nothing

End If

End If
Next ScCell
'MsgBox DD14.List(DD14.ListIndex)

 For Each key In Dic
 DD16.AddItem key
 Next