Message Box appears too much even if its not supposed to be show up

[Sekaya]

Hello everyone. Im just started practice on making macros. That macro is about finding a value from table 1 from sheet 1 copy and paste to table 2 from sheet 2 and delete it from table 1. It looks like working well but then i tried to add message box for unmatched value. If there is no match with value message box appears 4-5 times. Even if there are match macro doing the job but message box still appears 3-4 times. How can i fix it ?

Sub CopyProcedure()

Dim tdate As Date
tdate = Date
Dim x As String
x = InputBox("Tekne Adını Giriniz", "WİM")

    Dim i As Long
    Dim lRow1 As Long, lRow2 As Long
    Dim wsSayfa1 As Worksheet, wsSayfa2 As Worksheet

    Set wsSayfa1 = Sheets("Sayfa1")
    Set wsSayfa2 = Sheets("Sayfa2")

    lRow1 = wsSayfa1.Range("B" & wsSayfa1.Rows.Count).End(xlUp).Row

    
    For i = 2 To lRow1
        
        If wsSayfa1.Range("B" & i).Text = x Then
            
            lRow2 = wsSayfa2.Range("A" & wsSayfa2.Rows.Count).End(xlUp).Row + 1
            
            wsSayfa1.Range("B" & i, "D" & i).Copy
            
            wsSayfa2.Range("B" & lRow2).PasteSpecial xlPasteValues
            
            wsSayfa2.Range("E" & lRow2) = tdate
            wsSayfa2.Range("G" & lRow2) = ("VAR")
            Application.CutCopyMode = False
            wsSayfa1.Range("B" & i).EntireRow.Delete
        Else
            MsgBox "Girdiğiniz Tekne Adı Bulunamadı.", vbOKOnly, "WİM"
            
        End If
                   
    Next i

    Set wsSayfa1 = Nothing
    Set wsSayfa2 = Nothing

End Sub

 

[Fluff]

Hi & welcome to MrExcel.
Why not check to see if the value exists before the loop like

Sub CopyProcedure()

Dim tdate As Date
tdate = Date
Dim x As String
x = InputBox("Tekne Adini Giriniz", "WIM")

    Dim i As Long
    Dim lRow1 As Long, lRow2 As Long
    Dim wsSayfa1 As Worksheet, wsSayfa2 As Worksheet
    Dim Found As Range
    
    Set wsSayfa1 = Sheets("Sayfa1")
    Set wsSayfa2 = Sheets("Sayfa2")

    Set Found = wsSayfa1.Range("B:B").Find(x, , , xlWhole, , , True, , False)
    If Found Is Nothing Then
         MsgBox "Girdiginiz Tekne Adi Bulunamadi.", vbOKOnly, "WIM"
         Exit Sub
    End If
    lRow1 = wsSayfa1.Range("B" & wsSayfa1.Rows.Count).End(xlUp).Row

    
    For i = 2 To lRow1
        
        If wsSayfa1.Range("B" & i).Text = x Then
            
            lRow2 = wsSayfa2.Range("A" & wsSayfa2.Rows.Count).End(xlUp).Row + 1
            
            wsSayfa1.Range("B" & i, "D" & i).Copy
            
            wsSayfa2.Range("B" & lRow2).PasteSpecial xlPasteValues
            
            wsSayfa2.Range("E" & lRow2) = tdate
            wsSayfa2.Range("G" & lRow2) = ("VAR")
            Application.CutCopyMode = False
            wsSayfa1.Range("B" & i).EntireRow.Delete
        End If
                   
    Next i

    Set wsSayfa1 = Nothing
    Set wsSayfa2 = Nothing

End Sub

 

[Sekaya]

Hi & welcome to MrExcel.
Why not check to see if the value exists before the loop like

Sub CopyProcedure()

Dim tdate As Date
tdate = Date
Dim x As String
x = InputBox("Tekne Adini Giriniz", "WIM")

    Dim i As Long
    Dim lRow1 As Long, lRow2 As Long
    Dim wsSayfa1 As Worksheet, wsSayfa2 As Worksheet
    Dim Found As Range
   
    Set wsSayfa1 = Sheets("Sayfa1")
    Set wsSayfa2 = Sheets("Sayfa2")

    Set Found = wsSayfa1.Range("B:B").Find(x, , , xlWhole, , , True, , False)
    If Found Is Nothing Then
         MsgBox "Girdiginiz Tekne Adi Bulunamadi.", vbOKOnly, "WIM"
         Exit Sub
    End If
    lRow1 = wsSayfa1.Range("B" & wsSayfa1.Rows.Count).End(xlUp).Row

   
    For i = 2 To lRow1
       
        If wsSayfa1.Range("B" & i).Text = x Then
           
            lRow2 = wsSayfa2.Range("A" & wsSayfa2.Rows.Count).End(xlUp).Row + 1
           
            wsSayfa1.Range("B" & i, "D" & i).Copy
           
            wsSayfa2.Range("B" & lRow2).PasteSpecial xlPasteValues
           
            wsSayfa2.Range("E" & lRow2) = tdate
            wsSayfa2.Range("G" & lRow2) = ("VAR")
            Application.CutCopyMode = False
            wsSayfa1.Range("B" & i).EntireRow.Delete
        End If
                  
    Next i

    Set wsSayfa1 = Nothing
    Set wsSayfa2 = Nothing

End Sub

Thank you for your answer. It worked very well.

 

[Fluff]

You're welcome & thanks for the feedback.