VBA - Add argument in countif function - move rows

[Jeofbist3]

Hi everyone,

The code below aims to remove every row when the value in column M is 'Non Available' from sheet 'Summary' and put the entire row in another sheet 'Summarybis'. I'd like to add one argument in the countif function such as also removing every row with value in column M as 'To investigate' and also put it in the sheet 'Summarybis'. How can I do except by creating a new code and replacing what I need?

Finally, I think the above code is not entirely defined because it may happen that no output is produced (nothing is filled in sheet 'Summarybis'). What am I missing?
Thank you so much in advance !

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; white-space: inherit;">Sub removing_rows()
Dim Check As Range, lastrow As Long, lastrow2 As Long
lastrow = Worksheets("Summary").UsedRange.Rows.Count
lastrow2 = Worksheets("Summarybis").UsedRange.Rows.Count
If lastrow2 = 1 Then
lastrow2 = 0
Else
End If
Do While Application.WorksheetFunction.CountIf(Range("M:M"), "Non Available") > 0
Set Check = Range("M2:M" & lastrow)
For Each Cell In Check
If Cell = "Non Available" Then
Cell.EntireRow.Copy Destination:=Worksheets("Summarybis").Range("A" & lastrow2 + 1)
Cell.EntireRow.Delete
lastrow2 = lastrow2 + 1
Else:
End If
Next
Loop
End Sub
</code>

 

[timfritsch]

Something like this should work:

Sub removing_rows()
Dim Check As Range, lastRow As Long, lastRow2 As Long, rowLoop As Long

lastRow = Worksheets("Summary").UsedRange.Rows.Count
lastRow2 = Worksheets("Summarybis").UsedRange.Rows.Count

If lastRow2 = 1 Then lastRow2 = 0

If Application.WorksheetFunction.CountIf(Range("M:M"), "Non Available") + Application.WorksheetFunction.CountIf(Range("M:M"), "To investigate") > 0 Then
For rowLoop = lastRow To 1 Step -1

If Cells(rowLoop, "M") = "Non Available" Or Cells(rowLoop, "M") = "To investigate" Then
Rows(rowLoop).Copy Destination:=Worksheets("Summarybis").Range("A" & lastRow2 + 1)
Rows(rowLoop).Delete
lastRow2 = lastRow2 + 1
End If
Next rowLoop
End If
End Sub

Hope this helps.

Tim

 

[Jeofbist3]

Hello Tim,

Sorry for my delayed response, but i'm glad to announce you that the code you provided works really great

Super thanks!!

By the way, if I may, can someone tell me how to insert a top row in the sheet 'Summarybis' with pre defined headers (titles) ? I got the data filled in but without any title in each column.
I precise that the sheet 'Summarybis' is always empty before running the above code.

Thanks in advance

 

[timfritsch]

Glad to hear the suggestion worked.

To insert a row: Sheets("Summarybis").rows(1).insert

For the titles, I assume the Summary sheet has titles in row 1: Sheets("Summary").rows(1).copy Sheets("Summarybis").Range("A1")

Hope this helps.