"if instr" not working with a loop - vba

Question

I am a VBA beginner. I am trying to build a macro that would copy and paste (value) an entire row to a new sheet based on a differentiation criteria. The differentiation criteria, in this case, would be the content of specific cell. In other words, if the cell contains the word "Caviar" then copy the row into sheet 1 otherwise copy into sheet 2. The following macro works when I run it manually (row one by one).
Sub Search_and_copy()
Dim rng As String
rng = Sheets("40").Range("F11").Value
Dim rowNo As Integer
rowNo = 6
Dim celltxt As String
celltxt = Sheets("40").Range("P11").Value
rowNo = 6
If Sheets("40").Range("F11").Value = "254" Then
If InStr(celltxt, "CAVIAR") Then
Rows("11:11").Select
Selection.Copy
Sheets("Sheet1").Select
If IsEmpty(Cells(rowNo, 1)) Then
Sheets("Sheet1").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else: Do Until IsEmpty(Cells(rowNo, 1))
rowNo = rowNo + 1
Loop
Sheets("Sheet1").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Sheets("40").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Else
Rows("11:11").Select
Selection.Copy
Sheets("Sheet2").Select
If IsEmpty(Cells(rowNo, 1)) Then
Sheets("Sheet2").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else: Do Until IsEmpty(Cells(rowNo, 1))
rowNo = rowNo + 1
Loop
Sheets("Sheet2").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Sheets("40").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
End If
End Sub
However, as soon as I introduce a loop (see code below), the differentiation is no longer properly made and all rows are copied into the same worksheet. What am I doing wrong?
Sub Search_and_copy()
Dim rng As String
rng = Sheets("40").Range("F11").Value
Dim rowNo As Integer
rowNo = 6
Dim celltxt As String
celltxt = Sheets("40").Range("P11").Value
Do Until IsEmpty(Sheets("40").Range("F11").Value)
rowNo = 6
If Sheets("40").Range("F11").Value = "254" Then
If InStr(celltxt, "CAVIAR") Then
Rows("11:11").Select
Selection.Copy
Sheets("Sheet1").Select
If IsEmpty(Cells(rowNo, 1)) Then
Sheets("Sheet1").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else: Do Until IsEmpty(Cells(rowNo, 1))
rowNo = rowNo + 1
Loop
Sheets("Sheet1").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Sheets("40").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Else
Rows("11:11").Select
Selection.Copy
Sheets("Sheet2").Select
If IsEmpty(Cells(rowNo, 1)) Then
Sheets("Sheet2").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else: Do Until IsEmpty(Cells(rowNo, 1))
rowNo = rowNo + 1
Loop
Sheets("Sheet2").Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Sheets("40").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End If
End If
Loop
End Sub

Answer 1

The (first) problem is that you never change the value of celltxt inside your loop. After you read Sheets("40").Range("P11").Value into the string, you never change it. This means that InStr(celltxt, "CAVIAR") will always be the same until the Sub ends. All you should need to do is update it inside your loop.
One other thing to do while you're at it is to apply a little DRY and extract your common code into a function. The only difference between your If and Else is the sheet name. Try something like this:
Sub Search_and_copy()
Dim celltxt As String
Do Until IsEmpty(Sheets("40").Range("F11").Value)
celltxt = Sheets("40").Range("P11").Value
If Sheets("40").Range("F11").Value = "254" Then
If InStr(celltxt, "CAVIAR") Then
DontRepeatYourself "Sheet1"
Else
DontRepeatYourself "Sheet2"
End If
End If
Loop
End Sub
Private Sub DontRepeatYourself(sheet As String)
Dim rowNo As Long
rowNo = 6
Rows("11:11").Select
Selection.Copy
Sheets(sheet).Select
Do Until IsEmpty(Cells(rowNo, 1))
rowNo = rowNo + 1
Loop
Sheets(sheet).Cells(rowNo, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("40").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
End Sub