Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("E4:E" & Sheet3.Cells(Rows.Count, 4).End(xlUp).Row)) Is Nothing Then
Dim rng As Range, c As Range
Dim col As New Collection
MyList = vbNullString
i& = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = Sheet2.Range("B1:B" & i)
j& = 1
k& = ActiveCell.Row
For Each c In rng
If c.Value = Sheet3.Range("D" & k).Value Then
col.Add Sheet2.Cells(c.Row, 3)
MyList = MyList & col(j) & ","
With Sheet3.Range("E" & k).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=MyList
End With
j = j + 1
End If
Next
End If
Application.ScreenUpdating = True
End Sub