Remove rows in excel

Question

Here is a tricky question.

I have an Excel file containing roughly 4000 articles in each of the 10 sheets within the workbook. I would like to keep only about 400 articles and the remaining 3600 articles should be removed.

All sheets within the workbook has the article ID in column A.

All sheets has headers on row 1-5.

The article ID can exist more than once in some of the sheets.

I want to list the 400 article ID's in the Visual Basic Script itself so that i don't have to create a separate sheet or column that contains the information.

Can someone please help me? I have tried so many scripts, but nothing seems to work...

In the example below I want to keep Article ID's 5 and 1 (and of course the headers). The remaining 5 rows should be removed

This is what i have tried:

Sub Delete()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 6
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

For Lrow = Lastrow To Firstrow Step -1
    With .Cells(Lrow, "Y")
        If Not IsError(.Value) Then
            If InStr(.Value, 1) = 0 Or InStr(.Value, 5) = 0 Then  .EntireRow.Delete
        End If
    End With
 Next Lrow
End With
End Sub

But, I get two issues:

1. All rows are removed including the rows that I want to remove (1 and 5).

2. It only works on the open sheet and not the whole workbook.

Kind regards,

Peter

Answer 1

Try this code

Sub Test()

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Dim i As Long
        For i = 10 To 2 Step -1
            Select Case ws.Cells(i, 1).Value
            'add your ids for which you don't want to delete the rows
            Case 1, 5
                'do nothing
            Case Else
                ws.Cells(i, 1).EntireRow.Delete
            End Select
        Next i
    Next ws

End Sub

Answer 2

Try this code. At the start it will ask what IDs you want to keep in all worksheets. There you enter numbers separated by comma (,), no spaces or character other than comma and digits aren't allowed.

Sub DeleteArticles()
Dim i As Long
Dim strIDToKeep As String
Dim arrIDToKeep() As String
Dim ws As Worksheet
Dim lastRow As Long
strIDToKeep = InputBox("What IDs to keep?")
arrIDToKeep = Split(strIDToKeep, ",")

For Each ws In Worksheets
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = lastRow To 6 Step -1
        'if ID isn't present in array of IDs to keep, then we delete entire row
        If UBound(Filter(arrIDToKeep, ws.Cells(i, 1).Value)) = -1 Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next
Next
End Sub