VBA for cut Data for certain Keywords - vba

Question

I want cut data from A1:D10000 for certain keyword. Example if have any string with "Release Date:\n "it will be cut & paste in corresponding cell in F column.
I mean if any string have with "Release Date:\n " in C21 then it will be cut & paste in F21
I have a code & it works fine. But problem is it needs huge time to complete than i expected. Any better code as if it runs quickly?
My Code:
Sub Macro87()
For Repeat = 1 To 10000
Dim found As Range
Sheets("part15").Select
Range("A1").Select
Columns("A:D").EntireColumn.Select
Set found = Selection.Find(What:="Release Date:\n ", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
, MatchCase:=False, SearchFormat:=False)
If Not found Is Nothing Then
found.Select
ActiveCell.Select
Selection.Cut
Range("F" & (ActiveCell.Row)).Select
ActiveSheet.Paste
Set found = Nothing
End If
Next
End Sub

Answer 1

Firstly, stop going from 1 to 10,000 - you don't need to repeat the action so much when you can use .FindNext instead. Secondly, avoid like the plague the use of .Select.
Dim ws as Worksheet
Set ws = ThisWorkbook.Worksheets("part15")
Dim lastRow
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim found As Range
With ws.Range("A:D")
Set found = .Find(What:="Release Date:\n ", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext _
, MatchCase:=False, SearchFormat:=False)
If Not found Is Nothing Then
firstAddress = found.Address
Do
ws.Range("F" & found.Row).Value = found.Value
set found = .FindNext(found)
Loop While Not found Is Nothing And found.Address <> firstAddress
End If
End With
End Sub

Answer 2

As Dave mentioned, much of your slow down is going to come from the repeated select statements in your code. VBA usually does not need to select a range in order to work with the data therein. The following should speed things up for you quite a bit. It runs for me instantaneously:
Sub Macro87()
Set Rng = Range("A1:D10000")
For Each cel In Rng
If InStr(1, cel.Value, "Release Date:\n ") > 0 Then
Cells(cel.Row(), 6) = cel.Value
cel.Value = Empty
End If
Next cel
End Sub