Textbox ile filtrede değer bulunamadığı zaman hata

[aaaccc_aaaccc]

Merhabalar, excel programında vba ile kodlama yaparak çalıştırmak istediğim ufak bir programım var. Programda 1 tek şey hariç herşey düzgün çalışıyor. Çalışmayan ise; textbox ile filtreleme yaptığımda filtrelenen sütunda değer yoksa hata veriyor. Hata veren komut ise

"Application.Goto Reference:=Range(x.address), scroll:=False"

Kodların tamamını ekliyorum. Yardımcı olursanız çok sevinirim. Teşekkürler.

    Private Sub ComboBox5_Change()



    End Sub

    Private Sub ComboBox1_Change()
    ComboBox3.Value = "": ComboBox2.Value = ""
    If ComboBox1.Text <> "" Then
    Call baglan
    ComboBox2.Column = con.Execute("select [İLÇELER] from [Sayfa3$] where [İLLER]='" & ComboBox1.Text & "' group by [İLÇELER]").getrows
    Set con = Nothing
    Else
    ComboBox2.Clear: ComboBox3.Clear
    End If
    End Sub

    Private Sub ComboBox2_Change()
    ComboBox3.Text = ""
    If ComboBox2.Text <> "" Then
    Call baglan
    ComboBox3.Column = con.Execute("select [ÇALIŞANLAR] from [Sayfa3$] where [İLLER]='" & ComboBox1.Text & "'" & _
    " and [İLÇELER]='" & ComboBox2.Text & "'").getrows
    Set con = Nothing
    Else
    ComboBox3.Clear
    End If
    End Sub

    Private Sub ComboBox3_Change()
    ComboBox4.Text = ""
    If ComboBox3.Text <> "" Then
    Call baglan
    ComboBox4.Column = con.Execute("select [ÇALIŞANLAR] from [Sayfa3$] where [İLLER]='" & ComboBox1.Text & "'" & _
    " and [İLÇELER]='" & ComboBox2.Text & "'").getrows
    Set con = Nothing
    Else
    ComboBox3.Clear
    End If
    End Sub

    Private Sub ComboBox4_Change()

    End Sub



    Private Sub ComboBox6_Change()



    End Sub

    Private Sub CommandButton1_Click()
       
    If SatirSayisiVer > 1 Then
    MsgBox "Filtrelenen veriye göre benzersiz kayıt bulunamadı!"
    ElseIf SatirSayisiVer = 1 Then
    MsgBox "Veri Yaz"
    Kaydet
    ElseIf SatirSayisiVer = 0 Then
    MsgBox "Filtrelenen veriye göre hiçbir kayıt bulunamadı!"
    ElseIf SatirSayisiVer = -1 Then
    MsgBox "-1"
    End If

       

    End Sub


    Private Sub DTPicker21_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)

    End Sub

    Private Sub TextBox1_Change()

    TextBox1.MaxLength = 6
    SadeceSayi TextBox1

    Filtrele


    End Sub
    Sub SadeceSayi(obj)


    Dim i As Integer

    Dim str As String

    If TypeName(obj) = "TextBox" Then

    With obj

    For i = 1 To Len(obj.Text)

    str = Mid(.Text, i, 1)

    If Not IsNumeric(str) And .Value <> vbNullString Then

    .Text = Mid(obj.Text, 1, i - 1) & Mid(obj.Text, i + 1)
    MsgBox "Sadece Sayı Giriniz"

    End If

    Next

    End With

    End If

    End Sub


    Function Filtrele()


    ActiveCellDegistir IlkHucreBul
    Selection.AutoFilter Field:=9, Criteria1:="*" & TextBox1.Value & "*"

    If TextBox1.Value = "" Then
    Selection.AutoFilter Field:=9
    End If

    End Function

    Function SatirSayisiVer() As Integer

    Range("a1").Select
    Selection.CurrentRegion.Select
    row_count = Selection.Rows.Count - 3

    matched_criteria = 0
    check_row = 0

    Filtrele

    While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.RowHeight = 0 Then
            check_row = check_row + 1
        Else
            matched_criteria = matched_criteria + 1
        End If
    Wend

    ActiveCellDegistir IlkHucreBul

    If row_count = check_row Then
        SatirSayisiVer = -1
    Else
        SatirSayisiVer = matched_criteria
    End If


    End Function

    Function IlkHucreBul() As Range

    Dim aboneNo As String
    Dim ilkhucre As Range
    On Error Resume Next
    'aboneNo = (TextBox1.Value * 1)
    aboneNo = TextBox1.Value
    Set ilkhucre = Range("I3: I65000 ").Find(What:=aboneNo)

    Set IlkHucreBul = ilkhucre

    End Function


    Function ActiveCellDegistir(ilkhucre As Range)



    Application.Goto Reference:=Range(ilkhucre.Address), Scroll:=False


    End Function


    Function Kaydet()

    Dim activeSatir As Integer
    activeSatir = ActiveCell.Row
    Range("B" & activeSatir).Value = ComboBox1.Value
    Range("C" & activeSatir).Value = ComboBox2.Value

    End Function

 

[hamitcan]

İlgili fonksiyonu değiştirip deneyin. Bir hata olduğunda A1 hücresine yönlendirdim.

Function IlkHucreBul() As Range
    Dim aboneNo As String
    Dim ilkhucre As Range
    On Error Resume Next
    'aboneNo = (TextBox1.Value * 1)
    aboneNo = TextBox1.Value
    Set ilkhucre = Range("I3: I65000 ").Find(What:=aboneNo)
[color=red]if not ilkhucre is nothing then  Set IlkHucreBul = ilkhucre else Set IlkHucreBul = range("A1")[/color]
    End Function

 

[aaaccc_aaaccc]

İlgili fonksiyonu değiştirip deneyin. Bir hata olduğunda A1 hücresine yönlendirdim.

Function IlkHucreBul() As Range
    Dim aboneNo As String
    Dim ilkhucre As Range
    On Error Resume Next
    'aboneNo = (TextBox1.Value * 1)
    aboneNo = TextBox1.Value
    Set ilkhucre = Range("I3: I65000 ").Find(What:=aboneNo)
[color=red]if not ilkhucre is nothing then  Set IlkHucreBul = ilkhucre else Set IlkHucreBul = range("A1")[/color]
    End Function

Çok teşekkür ederim, çok yardımcı olduğunuz bana çok takıldım buraya nerede hata yapıyorum bulamıyrdum.


Peki bulamadığında ekrana msgbox ile uyarı verdirsem nasıl bir kodlama yaparım?

 

[hamitcan]

Böyle deneyin.

if not ilkhucre is nothing then  Set IlkHucreBul = ilkhucre else  IlkHucreBul ="Hata Var"