Copy row and one above it loop error?

[Phelony]

Hi guys

I've written the below and am a little stumped as to why it's not working.

The code is supposed to scan column B on the Invoices sheet, when it comes across an entry reading "payment", it marks the cell with as "pmark" it should then copy that line to the next available line in the CashC sheet and then repeat the process for the line above "pmark".

Unfortunately, all it's doing is cycling through the list in column B on Invoices as if the rest of the code weren't even there!

Ideas? Suggestions?
:dunno
Option Explicit
Sub findinvoice()
Dim pmark As Range
'set start point
Sheets("invoices").Range("B1").Activate
Do Until ActiveCell = ""
If ActiveCell = "payment" Then
'mark activecell as variable name
Set pmark = ActiveCell
Range(pmark).EntireRow.Select
Selection.Copy
'switch to secondary sheet
Sheets("cashc").Activate
Range("A1").Activate
Do Until ActiveCell = ""
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Activate

End If
Loop
Selection.PasteSpecial xlPasteValues
'return to variable location
Sheets("invoices").Range(pmark).Activate
Range(pmark).Offset(-1, 0).EntireRow.Select
Selection.Copy
'switch to secondary sheet again
Sheets("cashc").Activate
Range("A1").Activate
Do Until ActiveCell = ""

If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Activate
End If

Loop
Selection.PasteSpecial xlPasteValues
'closure of loop
Sheets("invoices").Range(pmark).Activate
pmark.Offset(1, 0).Activate
Set pmark = Nothing
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop
End Sub

[Rob342]

You are activating B1 & looping untill B1 = "", you need to look at the whole column B1 to the end of the data in ColB.
Then you need to do a search to find "payment" then copy & paste it to the other sheet.

[Phelony]

I ended up cheating:

Sub deletegarbage()
Do Until ActiveCell = ""
If ActiveCell.Offset(1, 0) = "Payment" Then
ActiveCell.Offset(2, 0).Activate
Else
ActiveCell.EntireRow.Delete
End If
Loop
End Sub

Thanks for the help anyway :hi:

[mdmackillop]

Maybe something like this?
Option Explicit
Sub findinvoice()
Dim pmark As Range
Dim i As Long
With Sheets("invoices")
Set pmark = Range(.Cells(1, 2), .Cells(Rows.Count, 2).End(xlUp))
End With
For i = pmark.Cells.Count To 1 Step -1
If pmark(i) = "payment" Then
pmark(i).Offset(-1).Resize(2).EntireRow.Copy
Sheets("CashC").Range("A1").Insert
End If
Next
End Sub