Copying the entire row if the cell isn't one of four determined values

Edited this is the code that answers the question

Dim i As Integer   

For i = 1 To Sheet1.UsedRange.Rows.Count        
    If Cells(i, "C") <> "Q" Then            
    Sheet1.Rows(i).EntireRow.Copy Sheets("Sheet2").Cells(i, 1)       
    End If
Next  

edit2 I'm now facing minor problems it would be great to figure out what's wrong with them. 1- This code is copying the cells but the problem is after pasting them in the other sheet there is gaps all over the place (they are the places of non-copied cells)

Dim i As Integer

For i = 1 To Sheet1.UsedRange.Rows.Count

    If Cells(i, "P") <> "Q"  Then

    Sheet1.Rows(i).EntireRow.Copy Sheets("Sheet2").Cells(i, 1)

    End If
Next    

the fix for this problem is to add .End(xlUp).Offset(1, 0) after the line that does the copy and pasting. I tried that before but i used Offset(1) and that didn't work

2-This code causes Excel to hang and i have to force it to close but when i reopen it the copied cells are there in the new sheet(i kind of know the problem, i think it's because Excel will check all cells since they are = 0 but i tried using the same for loop as the previous code but i kept getting errors)

Dim ro As Long
For Each cell In Sheets("Sheet1").range("U:U")
If (Len(cell.Value) = 0) Then
            ro = (ro + 1)
            Sheets("Sheet1").Rows(cell.Row).Copy Sheets("Sheet3").Rows(ro)
End If

Next  

the fix for #2 is to add a for loop of the rows count and include it, i knew that would fix it but i had problems with the syntax. The code needed the change in this line:

For Each cell In Sheets("Sheet1").range("U" & i)  

"i" being the for loop, just like the one in code #1

Answers


This code will iterate all of your rows in Column A and check if the text is a Q, W or E. If it isn't it'll copy that row.

Sub Test()
    Dim i As Integer
    'Loop to move through the rows
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        'Checks if it contains Q, W or E
        If Cells(i, 1) <> "Q" And Cells(i, 1) <> "W" And Cells(i, 1) <> "E" Then
            'Copy that row
            Rows(i).Copy
            'You said you know how to do the copy part so I won't include the rest...
        Else
            'Do something else
        End If
    Next
End Sub

Next time actually attempt the problem before asking for help. If it weren't so simple, people probably wouldn't help out too much. This is also something which is a quick google or SO search away.


AutoFilter does this quickly by avoiding loops, and will avoid the gaps on the rows copy

If you do have lower case q or w data then an advanced filter using EXACT will be needed on the output in the second sheet. See Debra's example here

Sub Clean()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range

Set ws1 = Sheets(1)
Set ws2 = Sheets(2)

Set rng1 = ws1.Range(ws1.[a1], ws1.Cells(Rows.Count, "A").End(xlUp))
With rng1
   .AutoFilter Field:=1, Field:=1, Criteria1:="<>Q", Operator:=xlAnd, Criteria2:="<>W"
   If rng1.Cells.Count > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy ws2.[a1]
End With
ws1.AutoFilterMode = False

End Sub

Need Your Help

Merging Clips with Different Resolutions

ios video merge avfoundation avassetexportsession

I have a set of video clips that I would like to merge together and then put a watermark on it.

Eclipse RAP - Firefox doesn't forget session

eclipse firefox session eclipse-rcp eclipse-rap

We've got an Eclipse RAP application that's behaving a bit strangely in Firefox - two distinct problems.