Help with VB Code

[dbomb1414]

I have the following code, however I only want it to find the first occurrence of what they typed in the input box and cut and paste that row. How do I update the code to do that.


Sub Test2()
Dim myWord$
myWord = InputBox("What key word to copy rows", "Enter your word")
If myWord = "" Then Exit Sub

Application.ScreenUpdating = False
Dim xRow&, NextRow&, LastRow&
NextRow = Sheets("Found").Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
LastRow = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For xRow = 1 To LastRow
If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then
Rows(xRow).Cut Sheets("Found").Rows(NextRow)
NextRow = NextRow + 1
End If
Next xRow
Application.ScreenUpdating = True

MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _
"''" & myWord & "''" & " were copied to Sheet2.", 64, "Done"
End Sub

 

[MARK858]

Maybe....

    For xRow = 1 To LastRow
        If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then
            Rows(xRow).Cut Sheets("Found").Rows(NextRow)
            Exit For
            NextRow = NextRow + 1
        End If
    Next xRow

 

[rlv01]

Alternatively.

Sub Test2()
    Dim myWord$, FoundWord As Range, Msg As String

    myWord = InputBox("What key word to copy rows", "Enter your word")
    If myWord = "" Then Exit Sub

    Application.ScreenUpdating = False
    With Sheets("Found")
        'Set FoundWord = .UsedRange.Find(What:=myWord, LookAt:=xlWhole, SearchOrder:=xlByRows) 'whole cell
        Set FoundWord = .UsedRange.Find(What:=myWord, LookAt:=xlPart, SearchOrder:=xlByRows)

        If Not FoundWord Is Nothing Then
            FoundWord.EntireRow.Cut .Rows(.UsedRange.Rows.Count + 1)
            Msg = "Macro is complete, row " & FoundWord.Row & " containing" & vbCrLf & "''" & myWord & "''" & " was copied to end"
        Else
            Msg = "Macro is complete." & vbCrLf & "''" & myWord & "''" & " was not found."
        End If
    End With
    Application.ScreenUpdating = True

    MsgBox Msg, 64, "Done"
End Sub