Extract entire row based on the cell value

[sindhuja]

Hi All,

All i want is to look for a column and find the values which are greater than zero. If any value is greater than zero then the entire row to be copied in Sheet 3.

Sounds simple and tried out. Its not giving me the desired output..
Amnot sue where am going wrong..

Any help will be helpful..

Attached sample data for the reference..

-Sindhuja

[MaximS]

try this:


Sub copy_paste()
Dim i, j, LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
j = 2
For i = 2 To LastRow
If Cells(i, 7).Value > 0 Then
Sheets("Sheet3").Range("A" & j & ":G" & j).Value = _
Sheets("Sheet1").Range("A" & i & ":G" & i).Value
j = j + 1
End If
Next
End Sub

[Demosthine]

Good Morning.

From what I read from your code in both your post and your file, you are attempting to verify whether the Column data on Sheet1 is greater than 0 or not. In your example, though, your file is looping through all of Column I on Sheet 3. If Sheet3 is empty, you will not have any values to search through. Additionally, on both Sheet1 and Sheet 3, Column I is empty. Do you mean Column G? Lastly, in the code, your comparison uses greater than or equal to. All of your values are at least. I believe you are trying to copy only rows with a value greater than 0. Reference code from file:


' Current Code
For Each cell In Sheet3.Range("i:i")
If (cell.Value) >= 0 Then
cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next cell

' Working Code
For Each Cell In Sheet1.Range("G:G")
If (Cell.Value) > 0 Then
Cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1)
ElseIf (Cell.Value) = "" Then
Exit Sub
End If
Next Cell


To fix the snippet, reference Sheet1.Range("G:G") at the start of your For Each statement and change >= to just >. I would, however, recommend you add a conditional exit from the For...Next loop to exit if it encounters an empty cell. This prevents you from processing all 65,000+ cells and safe a large amount of processing time.

Good luck.
Scott

[mp5]

I was looking for a similar solution and stumbled onto this thread. Demosthine, I got your code to work, but am looking for a way to copy values only.

So I added on the end...

'added .PasteSpecial(xlPasteValues)
For Each Cell In Sheet1.Range("G:G")
If (Cell.Value) > 0 Then
Cell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial(xlPasteValues)
ElseIf (Cell.Value) = "" Then
Exit Sub
End If
Next Cell

When I run this, I get: "Unable to get the PasteSpecial property of the range class.

Any suggestions are appreciated.

[Bob Phillips]

Dim NextRow As Long
Dim LastRow As Long
Dim cell As Range

With Worksheets("Sheet1")
LastRow = .Range("G" & .Rows.Count).End(xlUp).Row
End With

With Worksheets("Sheet3")
NextRow = .Range("A" & .Rows.Count).End(xlUp).Row
If .Cells(NextRow, "A").Value <> "" The n NextRow = NextRow + 1

For Each cell In Sheet1.Range("G1").Resize(Sheet1.Range("G1").End(xlDown).Row)
If cell.Value > 0 Then
cell.EntireRow.Copy
.Cells(NextRow, "A").PasteSpecial (xlPasteValues)
NextRow = NextRow + 1
ElseIf cell.Value = "" Then
Exit Sub
End If
Next cell
End With

[mp5]

XLD,
Works like a charm...