Listbox double click ile veriye gitme hatası

[obsesyonur]

Merhaba kısaca userform üzerinde bulunan listboxtan double click ile seçilen verinin,sayfa üzerindeki satırına gitmek isterken başka satırlara gidilmesi şeklinde bir hata ile karşılaştım.Örnek Belge içinde yapılmak istenilen olayı daha ayrıntılı biçimde anlattım.Yardımcı olabilecek herkese şimdiden teşekkür ederim.

listbox selected item&go.xlsm

[erseldemirel]

Bunu deneyin userform kodudur. Başka bir örnekten sıze uyarladım

Kod: Tümünü seç

Sub KayıtlarıAll()
    Dim KayıtSayısı, Satır As Variant
        ListBox1.Clear
    KayıtSayısı = Sheets("URUN BILGILERI").Cells(Rows.Count, "A").End(xlUp).Row
        For Satır = 1 To KayıtSayısı
    If InStr(UCase(Sheets("URUN BILGILERI").Range("A" & Satır)), TextBox1.Value) > 0 Then
        UserForm1.ListBox1.AddItem Sheets("URUN BILGILERI").Range("A" & Satır)
    End If
Next Satır
End Sub
Private Sub UserForm_Activate()
Call KayıtlarıAll
End Sub
Private Sub TextBox1_Change()
    Dim i As Integer
    Dim searchText As String
    Dim ws As Worksheet
    Dim lastRow As Long
        searchText = TextBox1.text
    ListBox1.Clear
    Set ws = ThisWorkbook.Sheets("URUN BILGILERI")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        For i = 1 To lastRow
        If InStr(1, ws.Cells(i, 1).Value, searchText, vbTextCompare) > 0 Then
            ListBox1.AddItem ws.Cells(i, 1).Value
            If searchText <> "" Then
                ListBox1.List(ListBox1.ListCount - 1, 1) = i
            End If
        End If
    Next i
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim selectedRow As Variant
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("URUN BILGILERI")
    If TextBox1.text <> "" Then
        selectedRow = ListBox1.List(ListBox1.ListIndex, 1)
    Else
        selectedRow = Application.Match(ListBox1.Value, ws.Columns(1), 0)
    End If
    If Not IsError(selectedRow) Then
        ws.Cells(selectedRow, 1).Select
    Else
        MsgBox "Hücre bulunamadı.", vbExclamation
    End If
Call KayıtlarıAll
End Sub

[obsesyonur]

Sayın erseldemirel gönderdiğiniz kodlar olması gerektiği gibi çalışıyor ve beni istediğim sonuca ulaştırıyor.Cevabınız için teşekkür ederim,konu çözüme kavuşmuştur.

[erseldemirel]

Kolay gelsin iyi gunler