Copy entire row if cell has specific value, looking at multiple columns and worksheets.

[tabbytomo]

Good morning from a very grey UK.

I'm having trouble getting my code to work, I'm trying to look in column M for the value "complete", then copy the entire row to another worksheet. Then, to look at column N for the value "complete" and copy the entire row to another worksheet. Then do the same again in several other worksheets.
The code so far looks at column M and copies the entire row where "complete" is found, but it does not work for column N and I cannot understand why. If I have multiple "complete" rows in column N, it's copying the first one it comes across, then stops. I have a "complete" value in N18, and one in N16, it's only copying across the value in N18 then appearing to stop.
Given this is the first stumbling block, I haven't yet looked at applying it to further worksheets.

Sub CompleteData()
     
Dim myrange As Range
Sheets("1. Data").Select
Set myrange = Sheets("1. Data").Range("M:M", Range("M" & Rows.Count).End(xlUp))
For Each cell In myrange
If cell.Value = "Complete" Then
lr = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row
cell.EntireRow.Copy Destination:=Sheets("Completed").Range("A" & lr + 1)
End If
Next cell

Sheets("1. Data").Select
Set myrange = Sheets("1. Data").Range("N:N", Range("N" & Rows.Count).End(xlUp))
For Each cell In myrange
If cell.Value = "Complete" Then
lr = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row
cell.EntireRow.Copy Destination:=Sheets("Completed").Range("A" & lr + 1)
End If
Next cell

End Sub

Any help greatly appreciated.

 

[NateSC]

I ran a quick test and it seemed OK as long as I had the word Complete capitalized. My first run through it was not and it didn't pick up any of the data. Double check your values in column N.

Also, if you want to streamline this a little, you can set this up with a Call statement and you pass it the relevant values that could change. You could even add a variable for the sheet name if you want to run this on other sheets. Pass it the sheet name and the column letter and it can add some flexibility and reduce your copy and pasting efforts. (Don't get me wrong, I've copied and pasted the same section of code many times. This is just a hint at what you can to do to make things a little cleaner and easier to work with.)

Sub CompleteData()
     
    Call CopyAcross("M")
    Call CopyAcross("N")

' Add more stuff to do here.

End Sub

Sub CopyAcross(checkCol As String)

    Dim myrange As Range
    
    Set myrange = Sheets("1. Data").Range(checkCol & ":" & checkCol, Range(checkCol & Rows.Count).End(xlUp))
    For Each Cell In myrange
        If Cell.Value = "Complete" Then
            lr = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row
            Cell.EntireRow.Copy Destination:=Sheets("Completed").Range("A" & lr + 1)
        End If
    Next Cell

End Sub

 

[NateSC]

One last thought. If you want to avoid the capitalization issue, just change the line where you are checking what the value equals so that it is forced to all caps (UCASE) or all lower case (LCASE). So it would look like one of the following:

If UCASE(Cell.Value) = "COMPLETE" Then

OR

If LCASE(Cell.Value) = "complete" Then