Hi there

I have the following code:

Private Sub ComboBox1_Change()

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Selection.Value = ListBox1.Value
    Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim rRng As Range, r As Range, rSortCr As String

Set rRng = Sheet2.Range("a2:a5567")
rSortCr = UCase(ActiveCell.Value)

For Each r In rRng
    If InStr(UCase(r), rSortCr) Then Me.ListBox1.AddItem r.Value
Next r

End Sub
Can anyone help me to edit the code so that if there is only one entry that meets the criteria, it will be just put into the selected cell when I run the macro?

Thank you.