move rows based on cell criteria from sheet to another

[abdelfattah]

hi
i have this code works well i would if is possible to make it copy rows what contains "not available" in one time in my case i have to press every time each row contains "not available " i find this is not practical and take me more time if i have 1000 rows of data

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim Lastrow As Long
Lastrow = Sheets("RESULT").Cells(Rows.Count, "F").End(xlUp).Row + 1

If Target.Value = "NOT AVAILABLE" Then
Rows(Target.Row).Copy Destination:=Sheets("RESULT").Rows(Lastrow)
Rows(Target.Row).Delete
End If
End If
End Sub

thanks

 

[JLGWhiz]

So you don'treally need the change event code. What would better suit your purposese is a code you can attach to a button like.

Sub notAvail()
Dim rng As Range
With ActiveSheet
    .UsedRange.AutoFilter 6, "Not available"
    Set rng = .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
    rng.Copy Sheets("RESULT").Cells(Rows.Count, 6).End(xlUp).Offset(1, -5)
    rng.EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

 

[abdelfattah]

many thanks i just want to ask you this is not possible that by change event code

 

[JLGWhiz]

many thanks i just want to ask you this is not possible that by change event code

The change event code would copy and paste as you make entries, one at a time as your original code did. You can use the change event to trigger the other code but then you would have duplicate entries of all the "Not available" items. You still might end up with duplicates with this code unless you delete the old data before running the code. Here is a modified version that would do that.

Sub notAvail()
Dim rng As Range
With ActiveSheet
    .UsedRange.AutoFilter 6, "Not available"
    Set rng = .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)
    If Not rng Is Nothing Then 
        Sheets("RESULT").UsedRange.Offset(1).ClearContents 'Removes old data from sheet
    End If
    rng.Copy Sheets("RESULT").Cells(Rows.Count, 6).End(xlUp).Offset(1, -5)
    rng.EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

 

[abdelfattah]

thanks JLGWhiz two codes are important but i have a last request how can i make the code when copy data also copy headers without i do that manually

 

[JLGWhiz]

thanks JLGWhiz two codes are important but i have a last request how can i make the code when copy data also copy headers without i do that manually

Sub notAvail()
Dim rng As Range
With ActiveSheet
    .UsedRange.AutoFilter 6, "Not available"
    Set rng = .UsedRange.SpecialCells(xlCellTypeVisible)
    If Not rng Is Nothing Then
        Sheets("RESULT").UsedRange.ClearContents 'Removes old data from sheet
    End If
    rng.Copy Sheets("RESULT").Range("A1")
    rng.EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

 

[abdelfattah]

you misunderstood it should stay the headers in sheet"data" not remove just copy to sheet "result " sorry if i don't make clear it

 

[JLGWhiz]

Sorry bout that. This should do what you want.

Sub notAvail()
Dim rng As Range
With ActiveSheet
    .UsedRange.AutoFilter 6, "Not available"
    Set rng = .UsedRange.SpecialCells(xlCellTypeVisible)
    If Not rng Is Nothing Then
        Sheets("RESULT").UsedRange.ClearContents 'Removes old data from sheet
        rng.Copy Sheets("RESULT").Range("A1")
    End If
    Set rng = rng.Offset(1)
    rng.Offset(1).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub

 

[abdelfattah]

actually i no know how the code works it causes some confusing it copy data without delete any rows from sheet"data" but when i add a new data based on "not available " it removes the lastrow and copy to sheet "result" it take me so long time to i explain you what happened for me

 

[JLGWhiz]

actually i no know how the code works it causes some confusing it copy data without delete any rows from sheet"data" but when i add a new data based on "not available " it removes the lastrow and copy to sheet "result" it take me so long time to i explain you what happened for me

Maybe you would be better off staying with your original code.