Need help modifying a code to copy only certain rows based off a criteria.

jamesttu1821 · Apr 25th 2022

I am trying to modify the criteria of this code to only copy rows from the Raw Data sheet that meet this criteria, If Column 5 or 6 is below 10 copy the row but If Columns 4, 5 and 6 = 0 then do not copy the row. Any help would be greatly appreciated.

Code

Dim x, y, i&, ii&, iii&


x = Sheets("Raw Data").Cells(1).CurrentRegion
ReDim y(1 To UBound(x, 1), 1 To 12)
For i = 2 To UBound(x, 1)
If x(i, 6) <= 10 Or x(i, 5) <= 10 Then
ii = ii + 1
For iii = 1 To 12
y(ii, iii) = x(i, iii)
Next
End If
Next
With Sheets("Hot List")
.Rows(2).Resize(100000).Delete
.Cells(2, 1).Resize(UBound(y, 1), 12) = y
.Columns(4).Resize(, 6).NumberFormat = "#,###"
.Columns(11).NumberFormat = "#,###"
End With


Range("A2").Select

Display More

**royUK** · Apr 26th 2022

Attach an example workbook.

**KjBox** · Apr 26th 2022

Try the attached file, I have amended the code assigned to the button to:

Code

Sub Hotlist()
    Dim x, y, i&, ii&, iii&
    
    x = Sheets("Raw Data").Cells(1).CurrentRegion
    ReDim y(1 To UBound(x, 1), 1 To 12)
    For i = 2 To UBound(x, 1)
        If (x(i, 5) <= 10 Or x(i, 6) <= 10) _
        And (x(i, 4) <> 0 And x(i, 5) <> 0 And x(i, 6) <> O) Then
            ii = ii + 1
            For iii = 1 To 12
                y(ii, iii) = x(i, iii)
            Next
        End If
    Next
    With Sheets("Hot List")
        .Rows(2).Resize(100000).Delete
        .Cells(2, 1).Resize(UBound(y, 1), 12) = y
        .Columns(4).Resize(, 6).NumberFormat = "#,###"
        .Columns(11).NumberFormat = "#,###"
    End With
    
End Sub

Display More

Need help modifying a code to copy only certain rows based off a criteria.

Participate now!

Share

Similar Threads

Insert New Row if needed

Autofilter and Copy Selected Columns to a new Sheet (in a different order)

Need to copy from sourcesheet to destination sheet only the new data entered based on serial no on the source sheet