Kod:
Private Sub Liste0_afterUpdate()
Dim v
Me.Kriter = ""
'EĞER LİSTE BOŞSA
If Me.Liste0.ItemsSelected.Count = 0 Then
Me.Liste2.RowSource = ""
MsgBox "LÜTFEN LİSTEDEN SEÇİM YAPIN", vbExclamation, "DİKKAT"
Exit Sub
Else '
'LİSTE KUTUSUNDAN KRİTER EKLEME
For Each v In Liste0.ItemsSelected
Id = Liste0.Column(1, v)
If Me.Kriter = "" Then
Me.Kriter = " Where Yer Like '*" & Liste0.Column(1, v) & "*'"
Else
Me.Kriter = Kriter & " And Yer Like '*" & Liste0.Column(1, v) & "*'"
End If
Next v
Liste2.RowSource = "Select Yerkod, Yer From Yer" & Me.Kriter
End If
End Sub